From c744635c304bed1b2f0437e18281a22c3192df81 Mon Sep 17 00:00:00 2001 From: Jakub Jelinek Date: Sun, 27 Oct 2019 21:46:54 +0100 Subject: * locales.c (iso_3166): Add missing comma after "United-States". From-SVN: r277492 --- gcc/ada/ChangeLog | 4 ++++ gcc/ada/locales.c | 2 +- 2 files changed, 5 insertions(+), 1 deletion(-) (limited to 'gcc/ada') diff --git a/gcc/ada/ChangeLog b/gcc/ada/ChangeLog index e0d4e65..193bd10 100644 --- a/gcc/ada/ChangeLog +++ b/gcc/ada/ChangeLog @@ -1,3 +1,7 @@ +2019-10-27 Jakub Jelinek + + * locales.c (iso_3166): Add missing comma after "United-States". + 2019-10-15 Arnaud Charlet * Makefile.rtl (a-except.o): Put -O1 earlier so that it can be diff --git a/gcc/ada/locales.c b/gcc/ada/locales.c index 2bf9003..9372bdb 100644 --- a/gcc/ada/locales.c +++ b/gcc/ada/locales.c @@ -529,7 +529,7 @@ static char* iso_3166[] = "UM", "United States Minor Outlying Islands", "US", "United States", "US", "United States of America", - "US", "United-States" + "US", "United-States", "UY", "Uruguay", "UZ", "Uzbekistan", -- cgit v1.1 From 3cf3da88be453f3fceaa596ee78be8d1e5aa21ca Mon Sep 17 00:00:00 2001 From: Eric Botcazou Date: Wed, 6 Nov 2019 10:57:18 +0000 Subject: introduce -fcallgraph-info option This was first submitted many years ago https://gcc.gnu.org/ml/gcc-patches/2010-10/msg02468.html The command line option -fcallgraph-info is added and makes the compiler generate another output file (xxx.ci) for each compilation unit (or LTO partitoin), which is a valid VCG file (you can launch your favorite VCG viewer on it unmodified) and contains the "final" callgraph of the unit. "final" is a bit of a misnomer as this is actually the callgraph at RTL expansion time, but since most high-level optimizations are done at the Tree level and RTL doesn't usually fiddle with calls, it's final in almost all cases. Moreover, the nodes can be decorated with additional info: -fcallgraph-info=su adds stack usage info and -fcallgraph-info=da dynamic allocation info. for gcc/ChangeLog From Eric Botcazou , Alexandre Oliva * common.opt (-fcallgraph-info[=]): New option. * doc/invoke.texi (Developer options): Document it. * opts.c (common_handle_option): Handle it. * builtins.c (expand_builtin_alloca): Record allocation if -fcallgraph-info=da. * calls.c (expand_call): If -fcallgraph-info, record the call. (emit_library_call_value_1): Likewise. * flag-types.h (enum callgraph_info_type): New type. * explow.c: Include stringpool.h. (set_stack_check_libfunc): Set SET_SYMBOL_REF_DECL on the symbol. * function.c (allocate_stack_usage_info): New. (allocate_struct_function): Call it for -fcallgraph-info. (prepare_function_start): Call it otherwise. (record_final_call, record_dynamic_alloc): New. * function.h (struct callinfo_callee): New. (CALLEE_FROM_CGRAPH_P): New. (struct callinfo_dalloc): New. (struct stack_usage): Add callees and dallocs. (record_final_call, record_dynamic_alloc): Declare. * gimplify.c (gimplify_decl_expr): Record dynamically-allocated object if -fcallgraph-info=da. * optabs-libfuncs.c (build_libfunc_function): Keep SYMBOL_REF_DECL. * print-tree.h (print_decl_identifier): Declare. (PRINT_DECL_ORIGIN, PRINT_DECL_NAME, PRINT_DECL_UNIQUE_NAME): New. * print-tree.c: Include print-tree.h. (print_decl_identifier): New function. * toplev.c: Include print-tree.h. (callgraph_info_file): New global variable. (callgraph_info_external_printed): Likewise. (output_stack_usage): Rename to... (output_stack_usage_1): ... this. Make it static, add cf parameter. If -fcallgraph-info=su, print stack usage to cf. If -fstack-usage, use print_decl_identifier for pretty-printing. (INDIRECT_CALL_NAME): New. (dump_final_node_vcg_start): New. (dump_final_callee_vcg, dump_final_node_vcg): New. (output_stack_usage): New. (lang_dependent_init): Open and start file if -fcallgraph-info. Allocated callgraph_info_external_printed. (finalize): If callgraph_info_file is not null, finish it, close it, and release callgraph_info_external_printed. for gcc/ada/ChangeLog * gcc-interface/misc.c (callgraph_info_file): Delete. Co-Authored-By: Alexandre Oliva From-SVN: r277876 --- gcc/ada/ChangeLog | 5 +++++ gcc/ada/gcc-interface/misc.c | 3 --- 2 files changed, 5 insertions(+), 3 deletions(-) (limited to 'gcc/ada') diff --git a/gcc/ada/ChangeLog b/gcc/ada/ChangeLog index 193bd10..c69910c 100644 --- a/gcc/ada/ChangeLog +++ b/gcc/ada/ChangeLog @@ -1,3 +1,8 @@ +2019-11-06 Eric Botcazou + Alexandre Oliva + + * gcc-interface/misc.c (callgraph_info_file): Delete. + 2019-10-27 Jakub Jelinek * locales.c (iso_3166): Add missing comma after "United-States". diff --git a/gcc/ada/gcc-interface/misc.c b/gcc/ada/gcc-interface/misc.c index 4abd4d5..d68b373 100644 --- a/gcc/ada/gcc-interface/misc.c +++ b/gcc/ada/gcc-interface/misc.c @@ -54,9 +54,6 @@ #include "ada-tree.h" #include "gigi.h" -/* This symbol needs to be defined for the front-end. */ -void *callgraph_info_file = NULL; - /* Command-line argc and argv. These variables are global since they are imported in back_end.adb. */ unsigned int save_argc; -- cgit v1.1 From ee499b407f6c59fe71c91fa7ad9686d1a4edfce3 Mon Sep 17 00:00:00 2001 From: Eric Botcazou Date: Mon, 25 Nov 2019 10:29:51 +0000 Subject: re PR ada/92575 (couple of suspicious assignments in expect.c) PR ada/92575 * expect.c (__gnat_expect_poll [VMS, HPUX]): Fix typo. From-SVN: r278671 --- gcc/ada/ChangeLog | 5 +++++ gcc/ada/expect.c | 4 ++-- 2 files changed, 7 insertions(+), 2 deletions(-) (limited to 'gcc/ada') diff --git a/gcc/ada/ChangeLog b/gcc/ada/ChangeLog index c69910c..a5b2a7c 100644 --- a/gcc/ada/ChangeLog +++ b/gcc/ada/ChangeLog @@ -1,3 +1,8 @@ +2019-11-25 Eric Botcazou + + PR ada/92575 + * expect.c (__gnat_expect_poll [VMS, HPUX]): Fix typo. + 2019-11-06 Eric Botcazou Alexandre Oliva diff --git a/gcc/ada/expect.c b/gcc/ada/expect.c index 349af3f..b8753ab 100644 --- a/gcc/ada/expect.c +++ b/gcc/ada/expect.c @@ -262,7 +262,7 @@ __gnat_expect_poll (int *fd, if ((status & 1) != 1) { ready = -1; - dead_process = i + 1; + *dead_process = i + 1; return ready; } } @@ -447,7 +447,7 @@ __gnat_expect_poll (int *fd, if (ei.request == TIOCCLOSE) { ioctl (fd[i], TIOCREQSET, &ei); - dead_process = i + 1; + *dead_process = i + 1; return -1; } -- cgit v1.1 From d587d1e4aa6a33372f64b0f3983ef66afa3d1897 Mon Sep 17 00:00:00 2001 From: Eric Botcazou Date: Mon, 25 Nov 2019 10:48:55 +0000 Subject: re PR ada/92362 (double elaboration of expression in Address aspect) PR ada/92362 * gcc-interface/trans.c (gnat_to_gnu) : Use a temporary instead of clobbering the result with a freeze node. From-SVN: r278675 --- gcc/ada/ChangeLog | 6 ++++++ gcc/ada/gcc-interface/trans.c | 8 ++++---- 2 files changed, 10 insertions(+), 4 deletions(-) (limited to 'gcc/ada') diff --git a/gcc/ada/ChangeLog b/gcc/ada/ChangeLog index a5b2a7c..dc00791 100644 --- a/gcc/ada/ChangeLog +++ b/gcc/ada/ChangeLog @@ -1,5 +1,11 @@ 2019-11-25 Eric Botcazou + PR ada/92362 + * gcc-interface/trans.c (gnat_to_gnu) : + Use a temporary instead of clobbering the result with a freeze node. + +2019-11-25 Eric Botcazou + PR ada/92575 * expect.c (__gnat_expect_poll [VMS, HPUX]): Fix typo. diff --git a/gcc/ada/gcc-interface/trans.c b/gcc/ada/gcc-interface/trans.c index 61e05d5..3d6f381 100644 --- a/gcc/ada/gcc-interface/trans.c +++ b/gcc/ada/gcc-interface/trans.c @@ -8421,7 +8421,7 @@ gnat_to_gnu (Node_Id gnat_node) gnat_temp = Entity (Name (gnat_node)); if (Freeze_Node (gnat_temp)) { - tree gnu_address = gnat_to_gnu (Expression (gnat_node)); + tree gnu_address = gnat_to_gnu (Expression (gnat_node)), gnu_temp; /* Get the value to use as the address and save it as the equivalent for the object; when it is frozen, gnat_to_gnu_entity will do the @@ -8431,7 +8431,7 @@ gnat_to_gnu (Node_Id gnat_node) of the object is limited and it is initialized with the result of a function call. */ if (Is_Subprogram (gnat_temp)) - gnu_result = gnu_address; + gnu_temp = gnu_address; else { tree gnu_type = gnat_to_gnu_type (Etype (gnat_temp)); @@ -8440,11 +8440,11 @@ gnat_to_gnu (Node_Id gnat_node) gnu_type = build_reference_type_for_mode (gnu_type, ptr_mode, true); gnu_address = convert (gnu_type, gnu_address); - gnu_result + gnu_temp = build_unary_op (INDIRECT_REF, NULL_TREE, gnu_address); } - save_gnu_tree (gnat_temp, gnu_result, true); + save_gnu_tree (gnat_temp, gnu_temp, true); } break; -- cgit v1.1 From 64c8ebc7b2796fb2376de6e011443d2b688cfd98 Mon Sep 17 00:00:00 2001 From: Eric Botcazou Date: Tue, 3 Dec 2019 10:06:15 +0000 Subject: decl.c (gnat_to_gnu_subprog_type): With the Copy-In/ Copy-Out mechanism... * gcc-interface/decl.c (gnat_to_gnu_subprog_type): With the Copy-In/ Copy-Out mechanism, do not promote the mode of the return type to an integral mode if it contains a field on a non-integral type and even demote it for 64-bit targets. From-SVN: r278927 --- gcc/ada/ChangeLog | 7 ++++++ gcc/ada/gcc-interface/decl.c | 59 ++++++++++++++++++++++++++++++++++++++------ 2 files changed, 58 insertions(+), 8 deletions(-) (limited to 'gcc/ada') diff --git a/gcc/ada/ChangeLog b/gcc/ada/ChangeLog index dc00791..487176d 100644 --- a/gcc/ada/ChangeLog +++ b/gcc/ada/ChangeLog @@ -1,3 +1,10 @@ +2019-12-03 Eric Botcazou + + * gcc-interface/decl.c (gnat_to_gnu_subprog_type): With the Copy-In/ + Copy-Out mechanism, do not promote the mode of the return type to an + integral mode if it contains a field on a non-integral type and even + demote it for 64-bit targets. + 2019-11-25 Eric Botcazou PR ada/92362 diff --git a/gcc/ada/gcc-interface/decl.c b/gcc/ada/gcc-interface/decl.c index 29c5a8e..b83f38c 100644 --- a/gcc/ada/gcc-interface/decl.c +++ b/gcc/ada/gcc-interface/decl.c @@ -5620,6 +5620,32 @@ gnat_to_gnu_profile_type (Entity_Id gnat_type) return gnu_type; } +/* Return true if TYPE contains only integral data, recursively if need be. */ + +static bool +type_contains_only_integral_data (tree type) +{ + switch (TREE_CODE (type)) + { + case RECORD_TYPE: + case UNION_TYPE: + case QUAL_UNION_TYPE: + for (tree field = TYPE_FIELDS (type); field; field = DECL_CHAIN (field)) + if (!type_contains_only_integral_data (TREE_TYPE (field))) + return false; + return true; + + case ARRAY_TYPE: + case COMPLEX_TYPE: + return type_contains_only_integral_data (TREE_TYPE (type)); + + default: + return INTEGRAL_TYPE_P (type); + } + + gcc_unreachable (); +} + /* Return a GCC tree for a subprogram type corresponding to GNAT_SUBPROG. DEFINITION is true if this is for a subprogram being defined. DEBUG_INFO_P is true if we need to write debug information for other types that we may @@ -5649,8 +5675,8 @@ gnat_to_gnu_subprog_type (Entity_Id gnat_subprog, bool definition, the TYPE_CI_CO_LIST field of the FUNCTION_TYPE node we create. */ tree gnu_cico_list = NULL_TREE; tree gnu_cico_return_type = NULL_TREE; - /* Fields in return type of procedure with copy-in copy-out parameters. */ - tree gnu_field_list = NULL_TREE; + tree gnu_cico_field_list = NULL_TREE; + bool gnu_cico_only_integral_type = true; /* The semantics of "pure" in Ada essentially matches that of "const" or "pure" in GCC. In particular, both properties are orthogonal to the "nothrow" property if the EH circuitry is explicit in the @@ -5976,9 +6002,11 @@ gnat_to_gnu_subprog_type (Entity_Id gnat_subprog, bool definition, NULL_TREE, 0, 0); Sloc_to_locus (Sloc (gnat_subprog), &DECL_SOURCE_LOCATION (gnu_field)); - gnu_field_list = gnu_field; + gnu_cico_field_list = gnu_field; gnu_cico_list = tree_cons (gnu_field, void_type_node, NULL_TREE); + if (!type_contains_only_integral_data (gnu_return_type)) + gnu_cico_only_integral_type = false; } TYPE_NAME (gnu_cico_return_type) = get_identifier ("RETURN"); @@ -5995,9 +6023,11 @@ gnat_to_gnu_subprog_type (Entity_Id gnat_subprog, bool definition, 0, 0); Sloc_to_locus (Sloc (gnat_param), &DECL_SOURCE_LOCATION (gnu_field)); - DECL_CHAIN (gnu_field) = gnu_field_list; - gnu_field_list = gnu_field; + DECL_CHAIN (gnu_field) = gnu_cico_field_list; + gnu_cico_field_list = gnu_field; gnu_cico_list = tree_cons (gnu_field, gnu_param, gnu_cico_list); + if (!type_contains_only_integral_data (gnu_param_type)) + gnu_cico_only_integral_type = false; } } @@ -6014,12 +6044,14 @@ gnat_to_gnu_subprog_type (Entity_Id gnat_subprog, bool definition, since structures are incomplete for the back-end. */ else if (Convention (gnat_subprog) != Convention_Stubbed) { - finish_record_type (gnu_cico_return_type, nreverse (gnu_field_list), + finish_record_type (gnu_cico_return_type, + nreverse (gnu_cico_field_list), 0, false); - /* Try to promote the mode of the return type if it is passed - in registers, again to speed up accesses. */ + /* Try to promote the mode if the return type is fully returned + in integer registers, again to speed up accesses. */ if (TYPE_MODE (gnu_cico_return_type) == BLKmode + && gnu_cico_only_integral_type && !targetm.calls.return_in_memory (gnu_cico_return_type, NULL_TREE)) { @@ -6042,6 +6074,17 @@ gnat_to_gnu_subprog_type (Entity_Id gnat_subprog, bool definition, } } + /* But demote the mode if the return type is partly returned in FP + registers to avoid creating problematic paradoxical subregs. + Note that we need to cater to historical 32-bit architectures + that incorrectly use the mode to select the return mechanism. */ + else if (INTEGRAL_MODE_P (TYPE_MODE (gnu_cico_return_type)) + && !gnu_cico_only_integral_type + && BITS_PER_WORD >= 64 + && !targetm.calls.return_in_memory (gnu_cico_return_type, + NULL_TREE)) + SET_TYPE_MODE (gnu_cico_return_type, BLKmode); + if (debug_info_p) rest_of_record_type_compilation (gnu_cico_return_type); } -- cgit v1.1 From cbcf36686e215a8a4bb5e824f8d8e40226b79757 Mon Sep 17 00:00:00 2001 From: Eric Botcazou Date: Tue, 3 Dec 2019 10:12:17 +0000 Subject: utils.c (fold_convert_size): New function. * gcc-interface/utils.c (fold_convert_size): New function. (fold_bit_position): Invoke it to do further folding. From-SVN: r278929 --- gcc/ada/ChangeLog | 5 +++++ gcc/ada/gcc-interface/utils.c | 22 +++++++++++++++------- 2 files changed, 20 insertions(+), 7 deletions(-) (limited to 'gcc/ada') diff --git a/gcc/ada/ChangeLog b/gcc/ada/ChangeLog index 487176d..f8b9f18 100644 --- a/gcc/ada/ChangeLog +++ b/gcc/ada/ChangeLog @@ -1,5 +1,10 @@ 2019-12-03 Eric Botcazou + * gcc-interface/utils.c (fold_convert_size): New function. + (fold_bit_position): Invoke it to do further folding. + +2019-12-03 Eric Botcazou + * gcc-interface/decl.c (gnat_to_gnu_subprog_type): With the Copy-In/ Copy-Out mechanism, do not promote the mode of the return type to an integral mode if it contains a field on a non-integral type and even diff --git a/gcc/ada/gcc-interface/utils.c b/gcc/ada/gcc-interface/utils.c index e14645a..80c0716 100644 --- a/gcc/ada/gcc-interface/utils.c +++ b/gcc/ada/gcc-interface/utils.c @@ -2349,19 +2349,27 @@ merge_sizes (tree last_size, tree first_bit, tree size, bool special, bool max) return new_size; } +/* Convert the size expression EXPR to TYPE and fold the result. */ + +static tree +fold_convert_size (tree type, tree expr) +{ + /* We assume that size expressions do not wrap around. */ + if (TREE_CODE (expr) == MULT_EXPR || TREE_CODE (expr) == PLUS_EXPR) + return size_binop (TREE_CODE (expr), + fold_convert_size (type, TREE_OPERAND (expr, 0)), + fold_convert_size (type, TREE_OPERAND (expr, 1))); + + return fold_convert (type, expr); +} + /* Return the bit position of FIELD, in bits from the start of the record, and fold it as much as possible. This is a tree of type bitsizetype. */ static tree fold_bit_position (const_tree field) { - tree offset = DECL_FIELD_OFFSET (field); - if (TREE_CODE (offset) == MULT_EXPR || TREE_CODE (offset) == PLUS_EXPR) - offset = size_binop (TREE_CODE (offset), - fold_convert (bitsizetype, TREE_OPERAND (offset, 0)), - fold_convert (bitsizetype, TREE_OPERAND (offset, 1))); - else - offset = fold_convert (bitsizetype, offset); + tree offset = fold_convert_size (bitsizetype, DECL_FIELD_OFFSET (field)); return size_binop (PLUS_EXPR, DECL_FIELD_BIT_OFFSET (field), size_binop (MULT_EXPR, offset, bitsize_unit_node)); } -- cgit v1.1 From 1058a2262b9dc15c164dec5261a9b3daad84e6d6 Mon Sep 17 00:00:00 2001 From: Eric Botcazou Date: Tue, 3 Dec 2019 10:23:06 +0000 Subject: utils.c (potential_alignment_gap): Delete. * gcc-interface/utils.c (potential_alignment_gap): Delete. (rest_of_record_type_compilation): Do not call above function. Use the alignment of the field instead of that of its type, if need be. When the original field has variable size, always lower the alignment of the pointer type. Reset the bit-field status of the new field if it does not encode a bit-field. From-SVN: r278930 --- gcc/ada/ChangeLog | 9 +++++ gcc/ada/gcc-interface/utils.c | 90 ++++++++++++++----------------------------- 2 files changed, 37 insertions(+), 62 deletions(-) (limited to 'gcc/ada') diff --git a/gcc/ada/ChangeLog b/gcc/ada/ChangeLog index f8b9f18..e454613 100644 --- a/gcc/ada/ChangeLog +++ b/gcc/ada/ChangeLog @@ -1,5 +1,14 @@ 2019-12-03 Eric Botcazou + * gcc-interface/utils.c (potential_alignment_gap): Delete. + (rest_of_record_type_compilation): Do not call above function. Use + the alignment of the field instead of that of its type, if need be. + When the original field has variable size, always lower the alignment + of the pointer type. Reset the bit-field status of the new field if + it does not encode a bit-field. + +2019-12-03 Eric Botcazou + * gcc-interface/utils.c (fold_convert_size): New function. (fold_bit_position): Invoke it to do further folding. diff --git a/gcc/ada/gcc-interface/utils.c b/gcc/ada/gcc-interface/utils.c index 80c0716..7217eea 100644 --- a/gcc/ada/gcc-interface/utils.c +++ b/gcc/ada/gcc-interface/utils.c @@ -288,7 +288,6 @@ static tree split_plus (tree, tree *); static tree float_type_for_precision (int, machine_mode); static tree convert_to_fat_pointer (tree, tree); static unsigned int scale_by_factor_of (tree, unsigned int); -static bool potential_alignment_gap (tree, tree, tree); /* Linked list used as a queue to defer the initialization of the DECL_CONTEXT of ..._DECL nodes and of the TYPE_CONTEXT of ..._TYPE nodes. */ @@ -2171,7 +2170,6 @@ rest_of_record_type_compilation (tree record_type) ? UNION_TYPE : TREE_CODE (record_type)); tree orig_name = TYPE_IDENTIFIER (record_type), new_name; tree last_pos = bitsize_zero_node; - tree old_field, prev_old_field = NULL_TREE; new_name = concat_name (orig_name, TREE_CODE (record_type) == QUAL_UNION_TYPE @@ -2189,7 +2187,8 @@ rest_of_record_type_compilation (tree record_type) /* Now scan all the fields, replacing each field with a new field corresponding to the new encoding. */ - for (old_field = TYPE_FIELDS (record_type); old_field; + for (tree old_field = TYPE_FIELDS (record_type); + old_field; old_field = DECL_CHAIN (old_field)) { tree field_type = TREE_TYPE (old_field); @@ -2213,9 +2212,10 @@ rest_of_record_type_compilation (tree record_type) else pos = compute_related_constant (curpos, last_pos); - if (!pos - && TREE_CODE (curpos) == MULT_EXPR - && tree_fits_uhwi_p (TREE_OPERAND (curpos, 1))) + if (pos) + ; + else if (TREE_CODE (curpos) == MULT_EXPR + && tree_fits_uhwi_p (TREE_OPERAND (curpos, 1))) { tree offset = TREE_OPERAND (curpos, 0); align = tree_to_uhwi (TREE_OPERAND (curpos, 1)); @@ -2223,8 +2223,7 @@ rest_of_record_type_compilation (tree record_type) last_pos = round_up (last_pos, align); pos = compute_related_constant (curpos, last_pos); } - else if (!pos - && TREE_CODE (curpos) == PLUS_EXPR + else if (TREE_CODE (curpos) == PLUS_EXPR && tree_fits_uhwi_p (TREE_OPERAND (curpos, 1)) && TREE_CODE (TREE_OPERAND (curpos, 0)) == MULT_EXPR && tree_fits_uhwi_p @@ -2240,9 +2239,9 @@ rest_of_record_type_compilation (tree record_type) last_pos = round_up (last_pos, align); pos = compute_related_constant (curpos, last_pos); } - else if (potential_alignment_gap (prev_old_field, old_field, pos)) + else { - align = TYPE_ALIGN (field_type); + align = DECL_ALIGN (old_field); last_pos = round_up (last_pos, align); pos = compute_related_constant (curpos, last_pos); } @@ -2261,13 +2260,17 @@ rest_of_record_type_compilation (tree record_type) in this case, if we don't preventively counter that. */ if (TREE_CODE (DECL_SIZE (old_field)) != INTEGER_CST) { - field_type = build_pointer_type (field_type); - if (align != 0 && TYPE_ALIGN (field_type) > align) + field_type = copy_type (build_pointer_type (field_type)); + SET_TYPE_ALIGN (field_type, BITS_PER_UNIT); + var = true; + + /* ??? Kludge to work around a bug in Workbench's debugger. */ + if (align == 0) { - field_type = copy_type (field_type); - SET_TYPE_ALIGN (field_type, align); + align = DECL_ALIGN (old_field); + last_pos = round_up (last_pos, align); + pos = compute_related_constant (curpos, last_pos); } - var = true; } /* Make a new field name, if necessary. */ @@ -2287,6 +2290,16 @@ rest_of_record_type_compilation (tree record_type) new_field = create_field_decl (field_name, field_type, new_record_type, DECL_SIZE (old_field), pos, 0, 0); + /* The specified position is not the actual position of the field + but the gap with the previous field, so the computation of the + bit-field status may be incorrect. We adjust it manually to + avoid generating useless attributes for the field in DWARF. */ + if (DECL_SIZE (old_field) == TYPE_SIZE (field_type) + && value_factor_p (pos, BITS_PER_UNIT)) + { + DECL_BIT_FIELD (new_field) = 0; + DECL_BIT_FIELD_TYPE (new_field) = NULL_TREE; + } DECL_CHAIN (new_field) = TYPE_FIELDS (new_record_type); TYPE_FIELDS (new_record_type) = new_field; @@ -2300,7 +2313,6 @@ rest_of_record_type_compilation (tree record_type) == QUAL_UNION_TYPE) ? bitsize_zero_node : DECL_SIZE (old_field)); - prev_old_field = old_field; } TYPE_FIELDS (new_record_type) = nreverse (TYPE_FIELDS (new_record_type)); @@ -3260,52 +3272,6 @@ scale_by_factor_of (tree expr, unsigned int value) return factor * value; } -/* Given two consecutive field decls PREV_FIELD and CURR_FIELD, return true - unless we can prove these 2 fields are laid out in such a way that no gap - exist between the end of PREV_FIELD and the beginning of CURR_FIELD. OFFSET - is the distance in bits between the end of PREV_FIELD and the starting - position of CURR_FIELD. It is ignored if null. */ - -static bool -potential_alignment_gap (tree prev_field, tree curr_field, tree offset) -{ - /* If this is the first field of the record, there cannot be any gap */ - if (!prev_field) - return false; - - /* If the previous field is a union type, then return false: The only - time when such a field is not the last field of the record is when - there are other components at fixed positions after it (meaning there - was a rep clause for every field), in which case we don't want the - alignment constraint to override them. */ - if (TREE_CODE (TREE_TYPE (prev_field)) == QUAL_UNION_TYPE) - return false; - - /* If the distance between the end of prev_field and the beginning of - curr_field is constant, then there is a gap if the value of this - constant is not null. */ - if (offset && tree_fits_uhwi_p (offset)) - return !integer_zerop (offset); - - /* If the size and position of the previous field are constant, - then check the sum of this size and position. There will be a gap - iff it is not multiple of the current field alignment. */ - if (tree_fits_uhwi_p (DECL_SIZE (prev_field)) - && tree_fits_uhwi_p (bit_position (prev_field))) - return ((tree_to_uhwi (bit_position (prev_field)) - + tree_to_uhwi (DECL_SIZE (prev_field))) - % DECL_ALIGN (curr_field) != 0); - - /* If both the position and size of the previous field are multiples - of the current field alignment, there cannot be any gap. */ - if (value_factor_p (bit_position (prev_field), DECL_ALIGN (curr_field)) - && value_factor_p (DECL_SIZE (prev_field), DECL_ALIGN (curr_field))) - return false; - - /* Fallback, return that there may be a potential gap */ - return true; -} - /* Return a LABEL_DECL with NAME. GNAT_NODE is used for the position of the decl. */ -- cgit v1.1 From dd2a16c741f11935fef856e29e6c71d27fd5c741 Mon Sep 17 00:00:00 2001 From: Eric Botcazou Date: Tue, 3 Dec 2019 23:10:46 +0000 Subject: re PR bootstrap/92783 (SEGV in field_byte_offset) PR bootstrap/92783 * gcc-interface/utils.c (rest_of_record_type_compilation): Move down the guard for the position of fields in the descriptive type. From-SVN: r278948 --- gcc/ada/gcc-interface/utils.c | 14 +++++++------- 1 file changed, 7 insertions(+), 7 deletions(-) (limited to 'gcc/ada') diff --git a/gcc/ada/gcc-interface/utils.c b/gcc/ada/gcc-interface/utils.c index 7217eea..fa98a5a 100644 --- a/gcc/ada/gcc-interface/utils.c +++ b/gcc/ada/gcc-interface/utils.c @@ -2246,13 +2246,6 @@ rest_of_record_type_compilation (tree record_type) pos = compute_related_constant (curpos, last_pos); } - /* If we can't compute a position, set it to zero. - - ??? We really should abort here, but it's too much work - to get this correct for all cases. */ - if (!pos) - pos = bitsize_zero_node; - /* See if this type is variable-sized and make a pointer type and indicate the indirection if so. Beware that the debug back-end may adjust the position computed above according @@ -2273,6 +2266,13 @@ rest_of_record_type_compilation (tree record_type) } } + /* If we can't compute a position, set it to zero. + + ??? We really should abort here, but it's too much work + to get this correct for all cases. */ + if (!pos) + pos = bitsize_zero_node; + /* Make a new field name, if necessary. */ if (var || align != 0) { -- cgit v1.1 From a1449c89b7272739d0ec32ad7ca4c53460337633 Mon Sep 17 00:00:00 2001 From: Dmitriy Anisimkov Date: Thu, 12 Dec 2019 10:01:41 +0000 Subject: [Ada] Improve end of command line arguments detection 2019-12-12 Dmitriy Anisimkov gcc/ada/ * libgnat/g-comlin.ads (Get_Argument): New routine similar to original Get_Argument but with one more out parameter End_Of_Arguments. (Get_Arguments): Comment improved. * libgnat/g-comlin.adb (Get_Argument): Implementation taken from original Get_Argument and improved. (Get_Argument): Calls new routine Get_Argument with additional parameter. From-SVN: r279277 --- gcc/ada/ChangeLog | 11 +++++++++++ gcc/ada/libgnat/g-comlin.adb | 29 ++++++++++++++++++++++------- gcc/ada/libgnat/g-comlin.ads | 15 +++++++++++++-- 3 files changed, 46 insertions(+), 9 deletions(-) (limited to 'gcc/ada') diff --git a/gcc/ada/ChangeLog b/gcc/ada/ChangeLog index e454613..8756dd7 100644 --- a/gcc/ada/ChangeLog +++ b/gcc/ada/ChangeLog @@ -1,3 +1,14 @@ +2019-12-12 Dmitriy Anisimkov + + * libgnat/g-comlin.ads (Get_Argument): New routine similar to + original Get_Argument but with one more out parameter + End_Of_Arguments. + (Get_Arguments): Comment improved. + * libgnat/g-comlin.adb (Get_Argument): Implementation taken from + original Get_Argument and improved. + (Get_Argument): Calls new routine Get_Argument with additional + parameter. + 2019-12-03 Eric Botcazou * gcc-interface/utils.c (potential_alignment_gap): Delete. diff --git a/gcc/ada/libgnat/g-comlin.adb b/gcc/ada/libgnat/g-comlin.adb index e3fac5b..ec057a9 100644 --- a/gcc/ada/libgnat/g-comlin.adb +++ b/gcc/ada/libgnat/g-comlin.adb @@ -385,10 +385,25 @@ package body GNAT.Command_Line is ------------------ function Get_Argument - (Do_Expansion : Boolean := False; + (Do_Expansion : Boolean := False; Parser : Opt_Parser := Command_Line_Parser) return String is + End_Of_Args : Boolean; begin + return Get_Argument (Do_Expansion, Parser, End_Of_Args); + end Get_Argument; + + ------------------ + -- Get_Argument -- + ------------------ + + function Get_Argument + (Do_Expansion : Boolean := False; + Parser : Opt_Parser := Command_Line_Parser; + End_Of_Arguments : out Boolean) return String is + begin + End_Of_Arguments := False; + if Parser.In_Expansion then declare S : constant String := Expansion (Parser.Expansion_It); @@ -415,6 +430,7 @@ package body GNAT.Command_Line is end loop; else + End_Of_Arguments := True; return String'(1 .. 0 => ' '); end if; @@ -436,9 +452,11 @@ package body GNAT.Command_Line is end loop; if Parser.Current_Argument > Parser.Arg_Count then + End_Of_Arguments := True; return String'(1 .. 0 => ' '); + elsif Parser.Section (Parser.Current_Argument) = 0 then - return Get_Argument (Do_Expansion); + return Get_Argument (Do_Expansion, Parser, End_Of_Arguments); end if; Parser.Current_Argument := Parser.Current_Argument + 1; @@ -451,13 +469,10 @@ package body GNAT.Command_Line is Argument (Parser, Parser.Current_Argument - 1); begin for Index in Arg'Range loop - if Arg (Index) = '*' - or else Arg (Index) = '?' - or else Arg (Index) = '[' - then + if Arg (Index) in '*' | '?' | '[' then Parser.In_Expansion := True; Start_Expansion (Parser.Expansion_It, Arg); - return Get_Argument (Do_Expansion, Parser); + return Get_Argument (Do_Expansion, Parser, End_Of_Arguments); end if; end loop; end; diff --git a/gcc/ada/libgnat/g-comlin.ads b/gcc/ada/libgnat/g-comlin.ads index 188b035..34feee7 100644 --- a/gcc/ada/libgnat/g-comlin.ads +++ b/gcc/ada/libgnat/g-comlin.ads @@ -462,8 +462,9 @@ package GNAT.Command_Line is function Get_Argument (Do_Expansion : Boolean := False; Parser : Opt_Parser := Command_Line_Parser) return String; - -- Returns the next element on the command line that is not a switch. This - -- function should not be called before Getopt has returned ASCII.NUL. + -- Returns the next element on the command line that is not a switch. This + -- function should be called either after Getopt has returned ASCII.NUL or + -- after Getopt procedure call. -- -- If Do_Expansion is True, then the parameter on the command line will -- be considered as a filename with wildcards, and will be expanded. The @@ -472,6 +473,16 @@ package GNAT.Command_Line is -- When there are no more arguments on the command line, this function -- returns an empty string. + function Get_Argument + (Do_Expansion : Boolean := False; + Parser : Opt_Parser := Command_Line_Parser; + End_Of_Arguments : out Boolean) return String; + -- The same as above but able to distinguish empty element in argument list + -- from end of arguments. + -- End_Of_Arguments is True if the end of the command line has been reached + -- (i.e. all available arguments have been returned by previous calls to + -- Get_Argument). + function Parameter (Parser : Opt_Parser := Command_Line_Parser) return String; -- Returns parameter associated with the last switch returned by Getopt. -- cgit v1.1 From c7732bbe382b982e60eb9d606752d012159d1a18 Mon Sep 17 00:00:00 2001 From: Eric Botcazou Date: Thu, 12 Dec 2019 10:01:46 +0000 Subject: [Ada] Mark Ada subprograms and variables referenced from gigi 2019-12-12 Eric Botcazou gcc/ada/ * atree.ads, comperr.ads, debug.ads, einfo.ads, elists.ads, err_vars.ads, errout.ads, exp_ch11.ads, exp_code.ads, exp_dbug.ads, exp_tss.ads, exp_util.ads, lib.ads, namet.ads, nlists.ads, opt.ads, repinfo.ads, restrict.ads, scos.ads, sem_aggr.ads, sem_aux.ads, sem_eval.ads, sem_util.ads, sinfo.ads, sinput.ads, stringt.ads, targparm.ads, types.ads, urealp.ads warnsw.ads: Add WARNING line(s) in commentary. * atree.h, elists.h, namet.h, nlists.h, repinfo.h, scos.h, stringt.h, types.h, uintp.h, urealp.h: Tidy up. * fe.h: Likewise. Document WARNING mark. From-SVN: r279278 --- gcc/ada/ChangeLog | 13 +++ gcc/ada/atree.ads | 2 + gcc/ada/atree.h | 6 +- gcc/ada/comperr.ads | 2 + gcc/ada/debug.ads | 2 + gcc/ada/einfo.ads | 6 ++ gcc/ada/elists.ads | 3 + gcc/ada/elists.h | 6 +- gcc/ada/err_vars.ads | 2 + gcc/ada/errout.ads | 6 ++ gcc/ada/exp_ch11.ads | 8 ++ gcc/ada/exp_code.ads | 2 + gcc/ada/exp_dbug.ads | 6 ++ gcc/ada/exp_tss.ads | 2 + gcc/ada/exp_util.ads | 4 + gcc/ada/fe.h | 261 +++++++++++++++++++++++++++------------------------ gcc/ada/lib.ads | 4 + gcc/ada/namet.ads | 1 - gcc/ada/namet.h | 44 +-------- gcc/ada/nlists.ads | 3 + gcc/ada/nlists.h | 6 +- gcc/ada/opt.ads | 22 +++++ gcc/ada/repinfo.ads | 3 + gcc/ada/repinfo.h | 4 +- gcc/ada/restrict.ads | 18 +++- gcc/ada/scos.ads | 6 +- gcc/ada/scos.h | 5 +- gcc/ada/sem_aggr.ads | 2 + gcc/ada/sem_aux.ads | 14 +++ gcc/ada/sem_eval.ads | 4 + gcc/ada/sem_util.ads | 30 ++++-- gcc/ada/sinfo.ads | 4 + gcc/ada/sinput.ads | 8 ++ gcc/ada/stringt.ads | 3 + gcc/ada/stringt.h | 6 +- gcc/ada/targparm.ads | 8 ++ gcc/ada/types.ads | 2 +- gcc/ada/types.h | 8 +- gcc/ada/uintp.h | 5 +- gcc/ada/urealp.ads | 3 + gcc/ada/urealp.h | 5 +- gcc/ada/warnsw.ads | 2 + 42 files changed, 352 insertions(+), 199 deletions(-) (limited to 'gcc/ada') diff --git a/gcc/ada/ChangeLog b/gcc/ada/ChangeLog index 8756dd7..4823313 100644 --- a/gcc/ada/ChangeLog +++ b/gcc/ada/ChangeLog @@ -1,3 +1,16 @@ +2019-12-12 Eric Botcazou + + * atree.ads, comperr.ads, debug.ads, einfo.ads, elists.ads, + err_vars.ads, errout.ads, exp_ch11.ads, exp_code.ads, + exp_dbug.ads, exp_tss.ads, exp_util.ads, lib.ads, namet.ads, + nlists.ads, opt.ads, repinfo.ads, restrict.ads, scos.ads, + sem_aggr.ads, sem_aux.ads, sem_eval.ads, sem_util.ads, + sinfo.ads, sinput.ads, stringt.ads, targparm.ads, types.ads, + urealp.ads warnsw.ads: Add WARNING line(s) in commentary. + * atree.h, elists.h, namet.h, nlists.h, repinfo.h, scos.h, + stringt.h, types.h, uintp.h, urealp.h: Tidy up. + * fe.h: Likewise. Document WARNING mark. + 2019-12-12 Dmitriy Anisimkov * libgnat/g-comlin.ads (Get_Argument): New routine similar to diff --git a/gcc/ada/atree.ads b/gcc/ada/atree.ads index e6617e9..491cde3 100644 --- a/gcc/ada/atree.ads +++ b/gcc/ada/atree.ads @@ -309,6 +309,8 @@ package Atree is -- switch -gnatQ is set. Initialized to zero at the start of compilation. -- Initialized for -gnatVa use, see comment above. + -- WARNING: There is a matching C declaration of this variable in fe.h + Total_Errors_Detected : Nat := 0; -- Number of errors detected so far. Includes count of serious errors and -- non-serious errors, so this value is always greater than or equal to the diff --git a/gcc/ada/atree.h b/gcc/ada/atree.h index 704ae9b..9187583 100644 --- a/gcc/ada/atree.h +++ b/gcc/ada/atree.h @@ -23,9 +23,9 @@ * * ****************************************************************************/ -/* This is the C header corresponding to the Ada package specification for - Atree. It also contains the implementations of inlined functions from the - package body for Atree. It was generated manually from atree.ads and +/* This is the C header that corresponds to the Ada package specification for + Atree. It also contains the implementation of inlined functions from the + package body for Atree. It was created manually from atree.ads and atree.adb and must be kept synchronized with changes in these files. Note that only routines for reading the tree are included, since the tree diff --git a/gcc/ada/comperr.ads b/gcc/ada/comperr.ads index d770419..2992e7d 100644 --- a/gcc/ada/comperr.ads +++ b/gcc/ada/comperr.ads @@ -50,6 +50,8 @@ package Comperr is -- for a GCC abort and false for a front end exception (with a possible -- message stored in TSD.Current_Excep). + -- WARNING: There is a matching C declaration of this subprogram in fe.h + procedure Delete_SCIL_Files; -- Delete SCIL files associated with the main unit diff --git a/gcc/ada/debug.ads b/gcc/ada/debug.ads index 0ad6920..2bbaae6 100644 --- a/gcc/ada/debug.ads +++ b/gcc/ada/debug.ads @@ -48,6 +48,8 @@ package Debug is -- is contained in the body of Debug rather than the spec, so that we don't -- have to recompile the world when a new debug flag is added. + -- WARNING: There is a matching C declaration of a few flags in fe.h + Debug_Flag_A : Boolean := False; Debug_Flag_B : Boolean := False; Debug_Flag_C : Boolean := False; diff --git a/gcc/ada/einfo.ads b/gcc/ada/einfo.ads index 5366631..c178e3a 100644 --- a/gcc/ada/einfo.ads +++ b/gcc/ada/einfo.ads @@ -7751,6 +7751,8 @@ package Einfo is -- Attribute Set Procedures -- ------------------------------ + -- WARNING: There is a matching C declaration of a few subprograms in fe.h + procedure Set_Abstract_States (Id : E; V : L); procedure Set_Accept_Address (Id : E; V : L); procedure Set_Access_Disp_Table (Id : E; V : L); @@ -8430,6 +8432,8 @@ package Einfo is -- value returned is the N_Attribute_Definition_Clause node, otherwise -- Empty is returned. + -- WARNING: There is a matching C declaration of this subprogram in fe.h + function Get_Pragma (E : Entity_Id; Id : Pragma_Id) return Node_Id; -- Searches the Rep_Item chain of entity E, for an instance of a pragma -- with the given pragma Id. If found, the value returned is the N_Pragma @@ -8500,6 +8504,8 @@ package Einfo is -- Test if the node N is the name of an entity (i.e. is an identifier, -- expanded name, or an attribute reference that returns an entity). + -- WARNING: There is a matching C declaration of this subprogram in fe.h + procedure Link_Entities (First : Entity_Id; Second : Entity_Id); -- Link entities First and Second in one entity chain. -- diff --git a/gcc/ada/elists.ads b/gcc/ada/elists.ads index 7a8a08b..8a3b364 100644 --- a/gcc/ada/elists.ads +++ b/gcc/ada/elists.ads @@ -37,6 +37,9 @@ -- through the nodes themselves (using the Link field), which is more time -- and space efficient, but a node can be only one such list. +-- WARNING: There is a C version of this package. Any changes to this +-- source file must be properly reflected in the C header file elists.h + with Types; use Types; with System; diff --git a/gcc/ada/elists.h b/gcc/ada/elists.h index 1b8588f..ac6efa2 100644 --- a/gcc/ada/elists.h +++ b/gcc/ada/elists.h @@ -23,9 +23,9 @@ * * ****************************************************************************/ -/* This is the C header corresponding to the Ada package specification for - Elists. It also contains the implementations of inlined functions from the - package body for Elists. It was generated manually from elists.ads and +/* This is the C header that corresponds to the Ada package specification for + Elists. It also contains the implementation of inlined functions from the + package body for Elists. It was created manually from elists.ads and elists.adb and must be kept synchronized with changes in these files. Note that only routines for reading the tree are included, since the diff --git a/gcc/ada/err_vars.ads b/gcc/ada/err_vars.ads index 861a4ee..cc0ffeb 100644 --- a/gcc/ada/err_vars.ads +++ b/gcc/ada/err_vars.ads @@ -113,6 +113,8 @@ package Err_Vars is Error_Msg_Uint_2 : Uint; -- Uint values for ^ insertion characters in message + -- WARNING: There is a matching C declaration of these variables in fe.h + Error_Msg_Sloc : Source_Ptr; -- Source location for # insertion character in message diff --git a/gcc/ada/errout.ads b/gcc/ada/errout.ads index 37db3e585..dfa6b86 100644 --- a/gcc/ada/errout.ads +++ b/gcc/ada/errout.ads @@ -734,6 +734,8 @@ package Errout is -- suppressed if the node N already has a message posted, or if it is a -- warning and N is an entity node for which warnings are suppressed. + -- WARNING: There is a matching C declaration of this subprogram in fe.h + procedure Error_Msg_F (Msg : String; N : Node_Id); -- Similar to Error_Msg_N except that the message is placed on the first -- node of the construct N (First_Node (N)). Note that this procedure uses @@ -750,6 +752,8 @@ package Errout is -- will contain a & or } as usual to mark the insertion point. This -- routine can be called from the parser or the analyzer. + -- WARNING: There is a matching C declaration of this subprogram in fe.h + procedure Error_Msg_FE (Msg : String; N : Node_Id; @@ -948,6 +952,8 @@ package Errout is -- This name is the identifier name as passed, cased according to the -- default identifier casing for the given file. + -- WARNING: There is a matching C declaration of this subprogram in fe.h + Size_Too_Small_Message : constant String := "size for& too small, minimum allowed is ^"; -- This message is explicitly tested in Special_Msg_Delete in the package diff --git a/gcc/ada/exp_ch11.ads b/gcc/ada/exp_ch11.ads index e5d8e21..afc9a40 100644 --- a/gcc/ada/exp_ch11.ads +++ b/gcc/ada/exp_ch11.ads @@ -70,6 +70,8 @@ package Exp_Ch11 is -- a goto statement. If Local_Raise is defined, its entity is returned, -- if not, Empty is returned (in which case the call is silently skipped). + -- WARNING: There is a matching C declaration of this subprogram in fe.h + function Get_RT_Exception_Entity (R : RT_Exception_Code) return Entity_Id; -- This function is provided for use by the back end in conjunction with -- generation of Local_Raise calls when an exception raise is converted to @@ -77,11 +79,15 @@ package Exp_Ch11 is -- to determine which Rcheck_nn procedure to call. The returned result is -- the exception entity to be passed to Local_Raise. + -- WARNING: There is a matching C declaration of this subprogram in fe.h + procedure Get_RT_Exception_Name (Code : RT_Exception_Code); -- This procedure is provided for use by the back end to obtain the name of -- the Rcheck procedure for Code. The name is appended to Namet.Name_Buffer -- without the __gnat_rcheck_ prefix. + -- WARNING: There is a matching C declaration of this subprogram in fe.h + procedure Possible_Local_Raise (N : Node_Id; E : Entity_Id); -- This procedure is called whenever node N might cause the back end -- to generate a local raise for a local Constraint/Program/Storage_Error @@ -95,4 +101,6 @@ package Exp_Ch11 is -- Issues warning if No_Exception_Propagation restriction is set. N is the -- node for the handler. + -- WARNING: There is a matching C declaration of this subprogram in fe.h + end Exp_Ch11; diff --git a/gcc/ada/exp_code.ads b/gcc/ada/exp_code.ads index 6c0cce7..f0b0111 100644 --- a/gcc/ada/exp_code.ads +++ b/gcc/ada/exp_code.ads @@ -38,6 +38,8 @@ package Exp_Code is -- Note that the implementations of these routines must not attempt -- to expand tables that are frozen on entry to Gigi. + -- WARNING: There is a matching C declaration of these subprograms in fe.h + function Is_Asm_Volatile (N : Node_Id) return Boolean; -- Given an N_Code_Statement node N, return True if Volatile=True is -- specified, and False if Volatile=False is specified (or set by default). diff --git a/gcc/ada/exp_dbug.ads b/gcc/ada/exp_dbug.ads index 93b9783..f2e2e60 100644 --- a/gcc/ada/exp_dbug.ads +++ b/gcc/ada/exp_dbug.ads @@ -441,6 +441,8 @@ package Exp_Dbug is -- generating code, since the necessary information for computing the -- proper external name is not available in this case. + -- WARNING: There is a matching C declaration of this subprogram in fe.h + ------------------------------------- -- Encoding for translation into C -- ------------------------------------- @@ -926,6 +928,8 @@ package Exp_Dbug is -- if we are not generating code, since the necessary information for -- computing the proper encoded name is not available in this case. + -- WARNING: There is a matching C declaration of this subprogram in fe.h + -------------- -- Renaming -- -------------- @@ -1391,6 +1395,8 @@ package Exp_Dbug is -- of the string in Name_Len, and an ASCII.NUL character stored following -- the name. + -- WARNING: There is a matching C declaration of this subprogram in fe.h + --------------------------------- -- Subtypes of Variant Records -- --------------------------------- diff --git a/gcc/ada/exp_tss.ads b/gcc/ada/exp_tss.ads index 61f2685..91c0c67 100644 --- a/gcc/ada/exp_tss.ads +++ b/gcc/ada/exp_tss.ads @@ -150,6 +150,8 @@ package Exp_Tss is function Is_Init_Proc (E : Entity_Id) return Boolean; -- Version for init procs, same as Is_TSS (E, TSS_Init_Proc); + -- WARNING: There is a matching C declaration of this subprogram in fe.h + function Is_TSS (E : Entity_Id; Nam : TSS_Name_Type) return Boolean; -- Determines if given entity (E) is the name of a TSS identified by Nam diff --git a/gcc/ada/exp_util.ads b/gcc/ada/exp_util.ads index 02fb233..03008ba 100644 --- a/gcc/ada/exp_util.ads +++ b/gcc/ada/exp_util.ads @@ -599,6 +599,8 @@ package Exp_Util is -- record component containing the tag of Iface if T implements Iface or -- Empty if it does not. + -- WARNING: There is a matching C declaration of this subprogram in fe.h + function Find_Prim_Op (T : Entity_Id; Name : Name_Id) return Entity_Id; -- Find the first primitive operation of a tagged type T with name Name. -- This function allows the use of a primitive operation which is not @@ -784,6 +786,8 @@ package Exp_Util is -- routine is useful for the case of a discriminated type, and testing for -- component overlap would be a pain. + -- WARNING: There is a matching C declaration of this subprogram in fe.h + function Is_Library_Level_Tagged_Type (Typ : Entity_Id) return Boolean; -- Return True if Typ is a library level tagged type. Currently we use -- this information to build statically allocated dispatch tables. diff --git a/gcc/ada/fe.h b/gcc/ada/fe.h index f62d67e..0ccd1a0 100644 --- a/gcc/ada/fe.h +++ b/gcc/ada/fe.h @@ -29,8 +29,14 @@ * * ****************************************************************************/ -/* This file contains declarations to access front-end functions and variables - used by gigi. +/* This is the C header that contains the declarations of Ada subprograms and + variables used by gigi and not declared in other C header files. It was + created manually from Ada specifications. The original Ada declarations + in these specifications must be marked with: + + "WARNING: There is a matching C declaration of this in fe.h" + + where is either "subprogram" or "variable". WARNING: functions taking String_Pointer parameters must abide by the rule documented alongside the definition of String_Pointer in types.h. */ @@ -41,23 +47,21 @@ extern "C" { /* atree: */ -#define Serious_Errors_Detected atree__serious_errors_detected +#define Serious_Errors_Detected atree__serious_errors_detected -/* comperr: */ +extern Nat Serious_Errors_Detected; -#define Compiler_Abort comperr__compiler_abort -extern int Compiler_Abort (String_Pointer, String_Pointer, Boolean) ATTRIBUTE_NORETURN; +/* comperr: */ -/* csets: */ +#define Compiler_Abort comperr__compiler_abort -#define Fold_Lower(C) csets__fold_lower[C] -#define Fold_Upper(C) csets__fold_upper[C] -extern char Fold_Lower[], Fold_Upper[]; +extern int Compiler_Abort (String_Pointer, String_Pointer, Boolean) ATTRIBUTE_NORETURN; /* debug: */ #define Debug_Flag_Dot_R debug__debug_flag_dot_r #define Debug_Flag_NN debug__debug_flag_nn + extern Boolean Debug_Flag_Dot_R; extern Boolean Debug_Flag_NN; @@ -81,59 +85,58 @@ extern void Set_Normalized_First_Bit (Entity_Id, Uint); extern void Set_Normalized_Position (Entity_Id, Uint); extern void Set_RM_Size (Entity_Id, Uint); -#define Is_Entity_Name einfo__is_entity_name +#define Is_Entity_Name einfo__is_entity_name + extern Boolean Is_Entity_Name (Node_Id); -#define Get_Attribute_Definition_Clause einfo__get_attribute_definition_clause +#define Get_Attribute_Definition_Clause einfo__get_attribute_definition_clause + extern Node_Id Get_Attribute_Definition_Clause (Entity_Id, unsigned char); /* errout: */ -#define Error_Msg_N errout__error_msg_n -#define Error_Msg_NE errout__error_msg_ne -#define Set_Identifier_Casing errout__set_identifier_casing +#define Error_Msg_N errout__error_msg_n +#define Error_Msg_NE errout__error_msg_ne +#define Set_Identifier_Casing errout__set_identifier_casing -extern void Error_Msg_N (String_Pointer, Node_Id); -extern void Error_Msg_NE (String_Pointer, Node_Id, Entity_Id); -extern void Set_Identifier_Casing (Char *, const Char *); +extern void Error_Msg_N (String_Pointer, Node_Id); +extern void Error_Msg_NE (String_Pointer, Node_Id, Entity_Id); +extern void Set_Identifier_Casing (Char *, const Char *); /* err_vars: */ -#define Error_Msg_Node_2 err_vars__error_msg_node_2 -#define Error_Msg_Uint_1 err_vars__error_msg_uint_1 -#define Error_Msg_Uint_2 err_vars__error_msg_uint_2 +#define Error_Msg_Uint_1 err_vars__error_msg_uint_1 +#define Error_Msg_Uint_2 err_vars__error_msg_uint_2 -extern Entity_Id Error_Msg_Node_2; -extern Uint Error_Msg_Uint_1; -extern Uint Error_Msg_Uint_2; -extern Nat Serious_Errors_Detected; +extern Uint Error_Msg_Uint_1; +extern Uint Error_Msg_Uint_2; /* exp_ch11: */ -#define Get_Local_Raise_Call_Entity exp_ch11__get_local_raise_call_entity -#define Get_RT_Exception_Entity exp_ch11__get_rt_exception_entity -#define Get_RT_Exception_Name exp_ch11__get_rt_exception_name -#define Warn_If_No_Local_Raise exp_ch11__warn_if_no_local_raise +#define Get_Local_Raise_Call_Entity exp_ch11__get_local_raise_call_entity +#define Get_RT_Exception_Entity exp_ch11__get_rt_exception_entity +#define Get_RT_Exception_Name exp_ch11__get_rt_exception_name +#define Warn_If_No_Local_Raise exp_ch11__warn_if_no_local_raise -extern Entity_Id Get_Local_Raise_Call_Entity (void); -extern Entity_Id Get_RT_Exception_Entity (int); -extern void Get_RT_Exception_Name (int); -extern void Warn_If_No_Local_Raise (int); +extern Entity_Id Get_Local_Raise_Call_Entity (void); +extern Entity_Id Get_RT_Exception_Entity (int); +extern void Get_RT_Exception_Name (int); +extern void Warn_If_No_Local_Raise (int); /* exp_code: */ -#define Asm_Input_Constraint exp_code__asm_input_constraint -#define Asm_Input_Value exp_code__asm_input_value -#define Asm_Output_Constraint exp_code__asm_output_constraint -#define Asm_Output_Variable exp_code__asm_output_variable -#define Asm_Template exp_code__asm_template -#define Clobber_Get_Next exp_code__clobber_get_next -#define Clobber_Setup exp_code__clobber_setup -#define Is_Asm_Volatile exp_code__is_asm_volatile -#define Next_Asm_Input exp_code__next_asm_input -#define Next_Asm_Output exp_code__next_asm_output -#define Setup_Asm_Inputs exp_code__setup_asm_inputs -#define Setup_Asm_Outputs exp_code__setup_asm_outputs +#define Asm_Input_Constraint exp_code__asm_input_constraint +#define Asm_Input_Value exp_code__asm_input_value +#define Asm_Output_Constraint exp_code__asm_output_constraint +#define Asm_Output_Variable exp_code__asm_output_variable +#define Asm_Template exp_code__asm_template +#define Clobber_Get_Next exp_code__clobber_get_next +#define Clobber_Setup exp_code__clobber_setup +#define Is_Asm_Volatile exp_code__is_asm_volatile +#define Next_Asm_Input exp_code__next_asm_input +#define Next_Asm_Output exp_code__next_asm_output +#define Setup_Asm_Inputs exp_code__setup_asm_inputs +#define Setup_Asm_Outputs exp_code__setup_asm_outputs extern Node_Id Asm_Input_Constraint (void); extern Node_Id Asm_Input_Value (void); @@ -150,22 +153,24 @@ extern void Setup_Asm_Outputs (Node_Id); /* exp_dbug: */ -#define Get_Encoded_Name exp_dbug__get_encoded_name -#define Get_External_Name exp_dbug__get_external_name +#define Get_Encoded_Name exp_dbug__get_encoded_name +#define Get_External_Name exp_dbug__get_external_name +#define Get_Variant_Encoding exp_dbug__get_variant_encoding -extern void Get_Encoded_Name (Entity_Id); -extern void Get_External_Name (Entity_Id, Boolean, String_Pointer); +extern void Get_Encoded_Name (Entity_Id); +extern void Get_External_Name (Entity_Id, Boolean, String_Pointer); +extern void Get_Variant_Encoding (Entity_Id); /* exp_tss: */ -#define Is_Init_Proc exp_tss__is_init_proc +#define Is_Init_Proc exp_tss__is_init_proc extern Boolean Is_Init_Proc (Entity_Id); /* exp_util: */ -#define Is_Fully_Repped_Tagged_Type exp_util__is_fully_repped_tagged_type -#define Find_Interface_Tag exp_util__find_interface_tag +#define Is_Fully_Repped_Tagged_Type exp_util__is_fully_repped_tagged_type +#define Find_Interface_Tag exp_util__find_interface_tag extern Boolean Is_Fully_Repped_Tagged_Type (Entity_Id); extern Entity_Id Find_Interface_Tag (Entity_Id, Entity_Id); @@ -175,26 +180,23 @@ extern Entity_Id Find_Interface_Tag (Entity_Id, Entity_Id); #define Cunit lib__cunit #define Ident_String lib__ident_string #define In_Extended_Main_Code_Unit lib__in_extended_main_code_unit -#define In_Same_Source_Unit lib__in_same_source_unit extern Node_Id Cunit (Unit_Number_Type); extern Node_Id Ident_String (Unit_Number_Type); extern Boolean In_Extended_Main_Code_Unit (Entity_Id); -extern Boolean In_Same_Source_Unit (Node_Id, Node_Id); /* opt: */ -#define Back_End_Inlining opt__back_end_inlining -#define Debug_Generated_Code opt__debug_generated_code -#define Exception_Extra_Info opt__exception_extra_info -#define Exception_Locations_Suppressed opt__exception_locations_suppressed -#define Exception_Mechanism opt__exception_mechanism -#define Float_Format opt__float_format -#define Generate_SCO_Instance_Table opt__generate_sco_instance_table -#define GNAT_Mode opt__gnat_mode -#define List_Representation_Info opt__list_representation_info -#define No_Strict_Aliasing_CP opt__no_strict_aliasing -#define Suppress_Checks opt__suppress_checks +#define Back_End_Inlining opt__back_end_inlining +#define Debug_Generated_Code opt__debug_generated_code +#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 +#define No_Strict_Aliasing_CP opt__no_strict_aliasing +#define Suppress_Checks opt__suppress_checks typedef enum { Front_End_SJLJ, Back_End_ZCX, Back_End_SJLJ @@ -205,122 +207,135 @@ extern Boolean Debug_Generated_Code; extern Boolean Exception_Extra_Info; extern Boolean Exception_Locations_Suppressed; extern Exception_Mechanism_Type Exception_Mechanism; -extern Char Float_Format; extern Boolean Generate_SCO_Instance_Table; extern Boolean GNAT_Mode; extern Int List_Representation_Info; extern Boolean No_Strict_Aliasing_CP; extern Boolean Suppress_Checks; -#define ZCX_Exceptions opt__zcx_exceptions -#define SJLJ_Exceptions opt__sjlj_exceptions -#define Front_End_Exceptions opt__front_end_exceptions -#define Back_End_Exceptions opt__back_end_exceptions +#define ZCX_Exceptions opt__zcx_exceptions +#define SJLJ_Exceptions opt__sjlj_exceptions +#define Front_End_Exceptions opt__front_end_exceptions +#define Back_End_Exceptions opt__back_end_exceptions -extern Boolean ZCX_Exceptions (void); -extern Boolean SJLJ_Exceptions (void); -extern Boolean Front_End_Exceptions (void); -extern Boolean Back_End_Exceptions (void); +extern Boolean ZCX_Exceptions (void); +extern Boolean SJLJ_Exceptions (void); +extern Boolean Front_End_Exceptions (void); +extern Boolean Back_End_Exceptions (void); /* restrict: */ -#define No_Exception_Handlers_Set restrict__no_exception_handlers_set -#define Check_No_Implicit_Heap_Alloc restrict__check_no_implicit_heap_alloc -#define Check_No_Implicit_Task_Alloc restrict__check_no_implicit_task_alloc -#define Check_No_Implicit_Protected_Alloc restrict__check_no_implicit_protected_alloc -#define Check_Elaboration_Code_Allowed restrict__check_elaboration_code_allowed -#define Check_Implicit_Dynamic_Code_Allowed restrict__check_implicit_dynamic_code_allowed - -extern Boolean No_Exception_Handlers_Set (void); -extern void Check_No_Implicit_Heap_Alloc (Node_Id); -extern void Check_No_Implicit_Task_Alloc (Node_Id); -extern void Check_No_Implicit_Protected_Alloc (Node_Id); -extern void Check_Elaboration_Code_Allowed (Node_Id); -extern void Check_Implicit_Dynamic_Code_Allowed (Node_Id); +#define Check_Elaboration_Code_Allowed \ + restrict__check_elaboration_code_allowed +#define Check_Implicit_Dynamic_Code_Allowed \ + restrict__check_implicit_dynamic_code_allowed +#define Check_No_Implicit_Heap_Alloc \ + restrict__check_no_implicit_heap_alloc +#define Check_No_Implicit_Protected_Alloc \ + restrict__check_no_implicit_protected_alloc +#define Check_No_Implicit_Task_Alloc \ + restrict__check_no_implicit_task_alloc +#define No_Exception_Handlers_Set \ + restrict__no_exception_handlers_set + +extern void Check_Elaboration_Code_Allowed (Node_Id); +extern void Check_Implicit_Dynamic_Code_Allowed (Node_Id); +extern void Check_No_Implicit_Heap_Alloc (Node_Id); +extern void Check_No_Implicit_Protected_Alloc (Node_Id); +extern void Check_No_Implicit_Task_Alloc (Node_Id); +extern Boolean No_Exception_Handlers_Set (void); /* sem_aggr: */ -#define Is_Others_Aggregate sem_aggr__is_others_aggregate +#define Is_Others_Aggregate sem_aggr__is_others_aggregate -extern Boolean Is_Others_Aggregate (Node_Id); +extern Boolean Is_Others_Aggregate (Node_Id); /* sem_aux: */ -#define Ancestor_Subtype sem_aux__ancestor_subtype -#define Constant_Value sem_aux__constant_value -#define First_Discriminant sem_aux__first_discriminant -#define First_Stored_Discriminant sem_aux__first_stored_discriminant -#define First_Subtype sem_aux__first_subtype -#define Is_By_Reference_Type sem_aux__is_by_reference_type -#define Is_Derived_Type sem_aux__is_derived_type - -extern Entity_Id Ancestor_Subtype (Entity_Id); -extern Node_Id Constant_Value (Entity_Id); -extern Entity_Id First_Discriminant (Entity_Id); -extern Entity_Id First_Stored_Discriminant (Entity_Id); -extern Entity_Id First_Subtype (Entity_Id); -extern Boolean Is_By_Reference_Type (Entity_Id); -extern Boolean Is_Derived_Type (Entity_Id); +#define Ancestor_Subtype sem_aux__ancestor_subtype +#define Constant_Value sem_aux__constant_value +#define First_Discriminant sem_aux__first_discriminant +#define First_Stored_Discriminant sem_aux__first_stored_discriminant +#define First_Subtype sem_aux__first_subtype +#define Is_By_Reference_Type sem_aux__is_by_reference_type +#define Is_Derived_Type sem_aux__is_derived_type + +extern Entity_Id Ancestor_Subtype (Entity_Id); +extern Node_Id Constant_Value (Entity_Id); +extern Entity_Id First_Discriminant (Entity_Id); +extern Entity_Id First_Stored_Discriminant (Entity_Id); +extern Entity_Id First_Subtype (Entity_Id); +extern Boolean Is_By_Reference_Type (Entity_Id); +extern Boolean Is_Derived_Type (Entity_Id); /* sem_eval: */ #define Compile_Time_Known_Value sem_eval__compile_time_known_value -#define Expr_Value sem_eval__expr_value -#define Expr_Value_S sem_eval__expr_value_s #define Is_OK_Static_Expression sem_eval__is_ok_static_expression -#define Is_OK_Static_Subtype sem_eval__is_ok_static_subtype -extern Uint Expr_Value (Node_Id); -extern Node_Id Expr_Value_S (Node_Id); -extern Boolean Compile_Time_Known_Value (Node_Id); -extern Boolean Is_OK_Static_Expression (Node_Id); -extern Boolean Is_OK_Static_Subtype (Entity_Id); +extern Boolean Compile_Time_Known_Value (Node_Id); +extern Boolean Is_OK_Static_Expression (Node_Id); /* sem_util: */ #define Defining_Entity sem_util__defining_entity #define First_Actual sem_util__first_actual -#define Next_Actual sem_util__next_actual #define Is_Atomic_Object sem_util__is_atomic_object #define Is_Variable_Size_Record sem_util__is_variable_size_record #define Is_Volatile_Object sem_util__is_volatile_object +#define Next_Actual sem_util__next_actual #define Requires_Transient_Scope sem_util__requires_transient_scope extern Entity_Id Defining_Entity (Node_Id); extern Node_Id First_Actual (Node_Id); -extern Node_Id Next_Actual (Node_Id); extern Boolean Is_Atomic_Object (Node_Id); extern Boolean Is_Variable_Size_Record (Entity_Id Id); extern Boolean Is_Volatile_Object (Node_Id); +extern Node_Id Next_Actual (Node_Id); extern Boolean Requires_Transient_Scope (Entity_Id); /* sinfo: */ #define End_Location sinfo__end_location -#define Set_Has_No_Elaboration_Code sinfo__set_has_no_elaboration_code +#define Set_Has_No_Elaboration_Code sinfo__set_has_no_elaboration_code #define Set_Present_Expr sinfo__set_present_expr extern Source_Ptr End_Location (Node_Id); extern void Set_Has_No_Elaboration_Code (Node_Id, Boolean); extern void Set_Present_Expr (Node_Id, Uint); +/* sinput: */ + +#define Debug_Source_Name sinput__debug_source_name +#define Get_Column_Number sinput__get_column_number +#define Get_Logical_Line_Number sinput__get_logical_line_number +#define Get_Source_File_Index sinput__get_source_file_index + +extern File_Name_Type Debug_Source_Name (Source_File_Index); +extern Column_Number_Type Get_Column_Number (Source_Ptr); +extern Line_Number_Type Get_Logical_Line_Number (Source_Ptr); +extern Source_File_Index Get_Source_File_Index (Source_Ptr); + /* targparm: */ -#define Backend_Overflow_Checks_On_Target targparm__backend_overflow_checks_on_target -#define Machine_Overflows_On_Target targparm__machine_overflows_on_target -#define Signed_Zeros_On_Target targparm__signed_zeros_on_target -#define Stack_Check_Probes_On_Target targparm__stack_check_probes_on_target -#define Stack_Check_Limits_On_Target targparm__stack_check_limits_on_target +#define Machine_Overflows_On_Target \ + targparm__machine_overflows_on_target +#define Signed_Zeros_On_Target \ + targparm__signed_zeros_on_target +#define Stack_Check_Limits_On_Target \ + targparm__stack_check_limits_on_target +#define Stack_Check_Probes_On_Target \ + targparm__stack_check_probes_on_target -extern Boolean Backend_Overflow_Checks_On_Target; extern Boolean Machine_Overflows_On_Target; extern Boolean Signed_Zeros_On_Target; -extern Boolean Stack_Check_Probes_On_Target; extern Boolean Stack_Check_Limits_On_Target; +extern Boolean Stack_Check_Probes_On_Target; /* warnsw: */ -#define Warn_On_Questionable_Layout warnsw__warn_on_questionable_layout +#define Warn_On_Questionable_Layout warnsw__warn_on_questionable_layout extern Boolean Warn_On_Questionable_Layout; diff --git a/gcc/ada/lib.ads b/gcc/ada/lib.ads index 7665f86..f20a18f 100644 --- a/gcc/ada/lib.ads +++ b/gcc/ada/lib.ads @@ -476,6 +476,8 @@ package Lib is function Unit_Name (U : Unit_Number_Type) return Unit_Name_Type; -- Get value of named field from given units table entry + -- WARNING: There is a matching C declaration of a few subprograms in fe.h + procedure Set_Cunit (U : Unit_Number_Type; N : Node_Id); procedure Set_Cunit_Entity (U : Unit_Number_Type; E : Entity_Id); procedure Set_Dynamic_Elab (U : Unit_Number_Type; B : Boolean := True); @@ -617,6 +619,8 @@ package Lib is -- the special case check to that routine. This avoids some difficulties -- with some other calls that malfunctioned with the odd return of True. + -- WARNING: There is a matching C declaration of this subprogram in fe.h + function In_Extended_Main_Code_Unit (Loc : Source_Ptr) return Boolean; -- Same function as above, but argument is a source pointer rather -- than a node. diff --git a/gcc/ada/namet.ads b/gcc/ada/namet.ads index bdd3dad..c00fdef 100644 --- a/gcc/ada/namet.ads +++ b/gcc/ada/namet.ads @@ -38,7 +38,6 @@ package Namet is -- WARNING: There is a C version of this package. Any changes to this -- source file must be properly reflected in the C header file namet.h --- which is created manually from namet.ads and namet.adb. -- This package contains routines for handling the names table. The table -- is used to store character strings for identifiers and operator symbols, diff --git a/gcc/ada/namet.h b/gcc/ada/namet.h index dfd93bb..d6011fa 100644 --- a/gcc/ada/namet.h +++ b/gcc/ada/namet.h @@ -23,9 +23,10 @@ * * ****************************************************************************/ -/* This is the C file that corresponds to the Ada package specification - Namet. It was created manually from files namet.ads and namet.adb. - Subprograms from Exp_Dbug and Sinput are also made accessible here. */ +/* This is the C header that corresponds to the Ada package specification for + Namet. It also contains the implementation of inlined functions from the + package body for Namet. It was created manually from namet.ads and + namet.adb and must be kept synchronized with changes in these files. */ #ifdef __cplusplus extern "C" { @@ -85,43 +86,6 @@ Get_Name_String (Name_Id Id) #define Name_Equals namet__name_equals extern Boolean Name_Equals (Name_Id, Name_Id); -/* The following routines and variables are not part of Namet, but we - include the header here since it seems the best place for it. */ - -#define Get_Encoded_Type_Name exp_dbug__get_encoded_type_name -extern Boolean Get_Encoded_Type_Name (Entity_Id); -#define Get_Variant_Encoding exp_dbug__get_variant_encoding -extern void Get_Variant_Encoding (Entity_Id); - -#define Spec_Context_List exp_dbug__spec_context_list -#define Body_Context_List exp_dbug__body_context_list -extern char *Spec_Context_List, *Body_Context_List; -#define Spec_Filename exp_dbug__spec_filename -#define Body_Filename exp_dbug__body_filename -extern char *Spec_Filename, *Body_Filename; - -/* Here are some functions in sinput.adb we call from trans.c. */ - -typedef Nat Source_File_Index; -typedef Int Logical_Line_Number; -typedef Int Column_Number; - -#define Debug_Source_Name sinput__debug_source_name -#define Full_Debug_Name sinput__full_debug_name -#define Reference_Name sinput__reference_name -#define Get_Source_File_Index sinput__get_source_file_index -#define Get_Logical_Line_Number sinput__get_logical_line_number -#define Get_Column_Number sinput__get_column_number -#define Instantiation sinput__instantiation - -extern File_Name_Type Debug_Source_Name (Source_File_Index); -extern File_Name_Type Full_Debug_Name (Source_File_Index); -extern File_Name_Type Reference_Name (Source_File_Index); -extern Source_File_Index Get_Source_File_Index (Source_Ptr); -extern Logical_Line_Number Get_Logical_Line_Number (Source_Ptr); -extern Column_Number Get_Column_Number (Source_Ptr); -extern Source_Ptr Instantiation (Source_File_Index); - #ifdef __cplusplus } #endif diff --git a/gcc/ada/nlists.ads b/gcc/ada/nlists.ads index 6aec482..1c6ae2c 100644 --- a/gcc/ada/nlists.ads +++ b/gcc/ada/nlists.ads @@ -35,6 +35,9 @@ -- package Elists which provides another form of lists that are not threaded -- through the nodes (and therefore allow nodes to be on multiple lists). +-- WARNING: There is a C version of this package. Any changes to this +-- source file must be properly reflected in the C header file nlists.h + with System; with Types; use Types; diff --git a/gcc/ada/nlists.h b/gcc/ada/nlists.h index 9475561..b678bab 100644 --- a/gcc/ada/nlists.h +++ b/gcc/ada/nlists.h @@ -23,9 +23,9 @@ * * ****************************************************************************/ -/* This is the C header corresponding to the Ada package specification for - Nlists. It also contains the implementations of inlined functions from - the package body for Nlists. It was generated manually from nlists.ads and +/* This is the C header that corresponds to the Ada package specification for + Nlists. It also contains the implementation of inlined functions from the + package body for Nlists. It was created manually from nlists.ads and nlists.adb and must be kept synchronized with changes in these files. Note that only routines for reading the tree are included, since the diff --git a/gcc/ada/opt.ads b/gcc/ada/opt.ads index 1f068dc..9453464 100644 --- a/gcc/ada/opt.ads +++ b/gcc/ada/opt.ads @@ -273,6 +273,8 @@ package Opt is -- 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 + Bind_Alternate_Main_Name : Boolean := False; -- GNATBIND -- True if main should be called Alternate_Main_Name.all. @@ -458,6 +460,8 @@ package Opt is -- of the original source code. Causes debugging information to be -- written with respect to the generated code file that is written. + -- WARNING: There is a matching C declaration of this variable in fe.h + Default_Pool : Node_Id := Empty; -- GNAT -- Used to record the storage pool name (or null literal) that is the @@ -595,11 +599,15 @@ package Opt is -- associated with exception messages (in particular range and index -- checks). + -- WARNING: There is a matching C declaration of this variable in fe.h + Exception_Locations_Suppressed : Boolean := False; -- GNAT -- Set to True if a Suppress_Exception_Locations configuration pragma is -- currently active. + -- WARNING: There is a matching C declaration of this variable in fe.h + type Exception_Mechanism_Type is -- Determines the kind of mechanism used to handle exceptions -- @@ -630,6 +638,8 @@ package Opt is -- (Frontend_Exceptions + 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 + function Back_End_Exceptions return Boolean; function Front_End_Exceptions return Boolean; function ZCX_Exceptions return Boolean; @@ -637,6 +647,8 @@ package Opt is -- GNAT -- Various properties of the active Exception_Mechanism + -- WARNING: There is a matching C declaration of these subprograms in fe.h + Exception_Tracebacks : Boolean := False; -- GNATBIND -- Set to True to store tracebacks in exception occurrences (-Ea or -E) @@ -781,6 +793,8 @@ package Opt is -- True when switch -fdump-scos is used. When True, a table of instances is -- included in SCOs. + -- WARNING: There is a matching C declaration of this variable in fe.h + Generating_Code : Boolean := False; -- GNAT -- True if the frontend finished its work and has called the backend to @@ -1008,6 +1022,8 @@ package Opt is -- 3 = like 2, but variable fields are decoded symbolically -- 4 = like 3, but list rep info for relevant compiler-generated types + -- WARNING: There is a matching C declaration of this variable in fe.h + List_Representation_Info_To_File : Boolean := False; -- GNAT -- Set true by -gnatRs switch. Causes information from -gnatR[1-4]m to be @@ -1209,6 +1225,8 @@ package Opt is -- GNAT -- Set True if pragma No_Strict_Aliasing with no parameters encountered. + -- WARNING: There is a matching C declaration of this variable in fe.h + No_Tagged_Streams : Node_Id := Empty; -- GNAT -- If a pragma No_Tagged_Streams is active for the current scope, this @@ -1541,6 +1559,8 @@ package Opt is -- GNAT -- Set to True if -gnatp (suppress all checks) switch present. + -- WARNING: There is a matching C declaration of this variable in fe.h + Suppress_Options : Suppress_Record; -- GNAT -- Indicates outer level setting of check suppression. This initializes @@ -2293,6 +2313,8 @@ package Opt is -- GNAT -- True if compiling in GNAT system mode (-gnatg switch) + -- WARNING: There is a matching C declaration of this variable in fe.h + GNAT_Mode_Config : Boolean := False; -- GNAT -- True if -gnatg switch is present. GNAT_Mode may be temporary set to diff --git a/gcc/ada/repinfo.ads b/gcc/ada/repinfo.ads index c51948e..c8eb350 100644 --- a/gcc/ada/repinfo.ads +++ b/gcc/ada/repinfo.ads @@ -35,6 +35,9 @@ -- compiler and in ASIS (it is used in ASIS as part of the implementation -- of the Data Decomposition Annex). +-- WARNING: There is a C version of this package. Any changes to this +-- source file must be properly reflected in the C header file repinfo.h + with Types; use Types; with Uintp; use Uintp; diff --git a/gcc/ada/repinfo.h b/gcc/ada/repinfo.h index 4708618..30c3e6d 100644 --- a/gcc/ada/repinfo.h +++ b/gcc/ada/repinfo.h @@ -29,7 +29,9 @@ * * ****************************************************************************/ -/* This file corresponds to the Ada file repinfo.ads. */ +/* This is the C header that corresponds to the Ada package specification for + Repinfo. It was created manually from repinfo.ads and must be kept + synchronized with changes in this file. */ #ifdef __cplusplus extern "C" { diff --git a/gcc/ada/restrict.ads b/gcc/ada/restrict.ads index a8e9fb1..80cd012 100644 --- a/gcc/ada/restrict.ads +++ b/gcc/ada/restrict.ads @@ -307,6 +307,8 @@ package Restrict is -- elaboration routine. If elaboration code is not allowed, an error -- message is posted on the node given as argument. + -- WARNING: There is a matching C declaration of this subprogram in fe.h + procedure Check_SPARK_05_Restriction (Msg : String; N : Node_Id; @@ -337,19 +339,27 @@ package Restrict is -- that generates a trampoline. If not allowed, an error message is posted -- on the node given as argument. + -- WARNING: There is a matching C declaration of this subprogram in fe.h + procedure Check_No_Implicit_Heap_Alloc (N : Node_Id); -- Equivalent to Check_Restriction (No_Implicit_Heap_Allocations, N). -- Provided for easy use by back end, which has to check this restriction. - procedure Check_No_Implicit_Task_Alloc (N : Node_Id); - -- Equivalent to Check_Restriction (No_Implicit_Task_Allocations, N). - -- Provided for easy use by back end, which has to check this restriction. + -- WARNING: There is a matching C declaration of this subprogram in fe.h procedure Check_No_Implicit_Protected_Alloc (N : Node_Id); -- Equivalent to: -- Check_Restriction (No_Implicit_Protected_Object_Allocations, N) -- Provided for easy use by back end, which has to check this restriction. + -- WARNING: There is a matching C declaration of this subprogram in fe.h + + procedure Check_No_Implicit_Task_Alloc (N : Node_Id); + -- Equivalent to Check_Restriction (No_Implicit_Task_Allocations, N). + -- Provided for easy use by back end, which has to check this restriction. + + -- WARNING: There is a matching C declaration of this subprogram in fe.h + procedure Check_Obsolescent_2005_Entity (E : Entity_Id; N : Node_Id); -- This routine checks if the entity E is one of the obsolescent entries -- in Ada.Characters.Handling in Ada 2005 and No_Obsolescent_Features @@ -394,6 +404,8 @@ package Restrict is -- set. In the latter case, the source may contain handlers but they either -- get converted using the local goto transformation or deleted. + -- WARNING: There is a matching C declaration of this subprogram in fe.h + function No_Exception_Propagation_Active return Boolean; -- Test to see if current restrictions settings specify that no -- exception propagation is activated. diff --git a/gcc/ada/scos.ads b/gcc/ada/scos.ads index b114acb..9f56297 100644 --- a/gcc/ada/scos.ads +++ b/gcc/ada/scos.ads @@ -28,6 +28,9 @@ -- the ALI file, and by Get_SCO/Put_SCO to read and write the text form that -- is used in the ALI file. +-- WARNING: There is a C version of this package. Any changes to this +-- source file must be properly reflected in the C header file scos.h + with Namet; use Namet; with Table; with Types; use Types; @@ -48,9 +51,6 @@ package SCOs is -- Put_SCO reads the internal tables and generates text lines in the ALI -- format. - -- WARNING: There are C bindings for this package. Any changes to this - -- source file must be properly reflected in the C header file scos.h - -------------------- -- SCO ALI Format -- -------------------- diff --git a/gcc/ada/scos.h b/gcc/ada/scos.h index a385264..53f9f38 100644 --- a/gcc/ada/scos.h +++ b/gcc/ada/scos.h @@ -23,8 +23,9 @@ * * ****************************************************************************/ -/* This is the C file that corresponds to the Ada package spec SCOs. It was - created manually from the file scos.ads. */ +/* This is the C header that corresponds to the Ada package specification for + Scos. It was created manually from scos.ads and must be kept synchronized + with changes in this file. */ #ifdef __cplusplus extern "C" { diff --git a/gcc/ada/sem_aggr.ads b/gcc/ada/sem_aggr.ads index 5f06b4d..1d4f348 100644 --- a/gcc/ada/sem_aggr.ads +++ b/gcc/ada/sem_aggr.ads @@ -37,4 +37,6 @@ package Sem_Aggr is function Is_Others_Aggregate (Aggr : Node_Id) return Boolean; -- Returns True is aggregate Aggr consists of a single OTHERS choice + -- WARNING: There is a matching C declaration of this subprogram in fe.h + end Sem_Aggr; diff --git a/gcc/ada/sem_aux.ads b/gcc/ada/sem_aux.ads index 55cfefa..ee3a2b3 100644 --- a/gcc/ada/sem_aux.ads +++ b/gcc/ada/sem_aux.ads @@ -91,6 +91,8 @@ package Sem_Aux is -- subtype then it returns the subtype or type from which the subtype was -- obtained, otherwise it returns Empty. + -- WARNING: There is a matching C declaration of this subprogram in fe.h + function Available_View (Ent : Entity_Id) return Entity_Id; -- Ent denotes an abstract state or a type that may come from a limited -- with clause. Return the non-limited view of Ent if there is one or Ent @@ -104,6 +106,8 @@ package Sem_Aux is -- constants from the point of view of constant folding. Empty is also -- returned for variables with no initialization expression. + -- WARNING: There is a matching C declaration of this subprogram in fe.h + function Corresponding_Unsigned_Type (Typ : Entity_Id) return Entity_Id; -- Typ is a signed integer subtype. This routine returns the standard -- unsigned type with the same Esize as the implementation base type of @@ -123,6 +127,8 @@ package Sem_Aux is -- When called on a private type with unknown discriminants, the function -- always returns Empty. + -- WARNING: There is a matching C declaration of this subprogram in fe.h + function First_Stored_Discriminant (Typ : Entity_Id) return Entity_Id; -- Typ is a type with discriminants. Gives the first discriminant stored -- in an object of this type. In many cases, these are the same as the @@ -146,11 +152,15 @@ package Sem_Aux is -- discriminants from Gigi's standpoint, i.e. those that will be stored in -- actual objects of the type. + -- WARNING: There is a matching C declaration of this subprogram in fe.h + function First_Subtype (Typ : Entity_Id) return Entity_Id; -- Applies to all types and subtypes. For types, yields the first subtype -- of the type. For subtypes, yields the first subtype of the base type of -- the subtype. + -- WARNING: There is a matching C declaration of this subprogram in fe.h + function First_Tag_Component (Typ : Entity_Id) return Entity_Id; -- Typ must be a tagged record type. This function returns the Entity for -- the first _Tag field in the record type. @@ -317,6 +327,8 @@ package Sem_Aux is -- Ent is any entity. Returns True if Ent is a type entity where the type -- is required to be passed by reference, as defined in (RM 6.2(4-9)). + -- WARNING: There is a matching C declaration of this subprogram in fe.h + function Is_Definite_Subtype (T : Entity_Id) return Boolean; -- T is a type entity. Returns True if T is a definite subtype. -- Indefinite subtypes are unconstrained arrays, unconstrained @@ -329,6 +341,8 @@ package Sem_Aux is -- Determines if the given entity Ent is a derived type. Result is always -- false if argument is not a type. + -- WARNING: There is a matching C declaration of this subprogram in fe.h + function Is_Generic_Formal (E : Entity_Id) return Boolean; -- Determine whether E is a generic formal parameter. In particular this is -- used to set the visibility of generic formals of a generic package diff --git a/gcc/ada/sem_eval.ads b/gcc/ada/sem_eval.ads index 477b5f8..0a2bc64 100644 --- a/gcc/ada/sem_eval.ads +++ b/gcc/ada/sem_eval.ads @@ -224,6 +224,8 @@ package Sem_Eval is -- efficient with compile time known values, e.g. range analysis for the -- purpose of removing checks is more effective if we know precise bounds. + -- WARNING: There is a matching C declaration of this subprogram in fe.h + function Compile_Time_Known_Value_Or_Aggr (Op : Node_Id) return Boolean; -- Similar to Compile_Time_Known_Value, but also returns True if the value -- is a compile-time-known aggregate, i.e. an aggregate all of whose @@ -412,6 +414,8 @@ package Sem_Eval is -- for compile time evaluation purposes. Use Compile_Time_Known_Value -- instead (see section on "Compile-Time Known Values" above). + -- WARNING: There is a matching C declaration of this subprogram in fe.h + function Is_OK_Static_Range (N : Node_Id) return Boolean; -- Determines if range is static, as defined in RM 4.9(26), and also checks -- that neither bound of the range raises constraint error, thus ensuring diff --git a/gcc/ada/sem_util.ads b/gcc/ada/sem_util.ads index dc5e57b..ace843e 100644 --- a/gcc/ada/sem_util.ads +++ b/gcc/ada/sem_util.ads @@ -566,6 +566,8 @@ package Sem_Util is -- debugging information, generated through Qualify_Entity_Names, and -- the loop declaration must be placed in the table Name_Qualify_Units. + -- WARNING: There is a matching C declaration of this subprogram in fe.h + function Denotes_Discriminant (N : Node_Id; Check_Concurrent : Boolean := False) return Boolean; @@ -901,6 +903,8 @@ package Sem_Util is -- Note that the value returned is always the expression (not the -- N_Parameter_Association nodes, even if named association is used). + -- WARNING: There is a matching C declaration of this subprogram in fe.h + function First_Global (Subp : Entity_Id; Global_Mode : Name_Id; @@ -1526,6 +1530,8 @@ package Sem_Util is -- Determine whether arbitrary node N denotes a reference to an atomic -- object as per Ada RM C.6(12). + -- WARNING: There is a matching C declaration of this subprogram in fe.h + function Is_Atomic_Object_Entity (Id : Entity_Id) return Boolean; -- Determine whether arbitrary entity Id denotes an atomic object as per -- Ada RM C.6(12). @@ -2062,6 +2068,8 @@ package Sem_Util is function Is_Variable_Size_Record (E : Entity_Id) return Boolean; -- Returns true if E has variable size components + -- WARNING: There is a matching C declaration of this subprogram in fe.h + function Is_Variable (N : Node_Id; Use_Original_Node : Boolean := True) return Boolean; @@ -2093,6 +2101,8 @@ package Sem_Util is -- for something actually declared as volatile, not for an object that gets -- treated as volatile (see Einfo.Treat_As_Volatile). + -- WARNING: There is a matching C declaration of this subprogram in fe.h + generic with procedure Handle_Parameter (Formal : Entity_Id; Actual : Node_Id); procedure Iterate_Call_Parameters (Call : Node_Id); @@ -2361,11 +2371,6 @@ package Sem_Util is -- when the resulting entity does not have to be referenced as a -- public entity (and in this case Is_Public is not set). - procedure Next_Actual (Actual_Id : in out Node_Id); - pragma Inline (Next_Actual); - -- Next_Actual (N) is equivalent to N := Next_Actual (N). Note that we - -- inline this procedural form, but not the functional form that follows. - function Next_Actual (Actual_Id : Node_Id) return Node_Id; -- Find next actual parameter in declaration order. As described for -- First_Actual, this is the next actual in the declaration order, not @@ -2375,16 +2380,23 @@ package Sem_Util is -- Note that the result produced is always an expression, not a parameter -- association node, even if named notation was used. - procedure Next_Global (Node : in out Node_Id); + -- WARNING: There is a matching C declaration of this subprogram in fe.h + + procedure Next_Actual (Actual_Id : in out Node_Id); pragma Inline (Next_Actual); - -- Next_Global (N) is equivalent to N := Next_Global (N). Note that we - -- inline this procedural form, but not the functional form that follows. + -- Next_Actual (N) is equivalent to N := Next_Actual (N). Note that we + -- inline this procedural form, but not the functional form above. function Next_Global (Node : Node_Id) return Node_Id; -- Node is a global item from a list, obtained through calling First_Global -- and possibly Next_Global a number of times. Returns the next global item -- with the same mode. + procedure Next_Global (Node : in out Node_Id); + pragma Inline (Next_Actual); + -- Next_Global (N) is equivalent to N := Next_Global (N). Note that we + -- inline this procedural form, but not the functional form above. + function No_Caching_Enabled (Id : Entity_Id) return Boolean; -- Given the entity of a variable, determine whether Id is subject to -- volatility property No_Caching and if it is, the related expression @@ -2588,6 +2600,8 @@ package Sem_Util is -- controlled types and variable-sized types including unconstrained -- arrays. + -- WARNING: There is a matching C declaration of this subprogram in fe.h + procedure Reset_Analyzed_Flags (N : Node_Id); -- Reset the Analyzed flags in all nodes of the tree whose root is N diff --git a/gcc/ada/sinfo.ads b/gcc/ada/sinfo.ads index 5a92066..c64a76f 100644 --- a/gcc/ada/sinfo.ads +++ b/gcc/ada/sinfo.ads @@ -10343,6 +10343,8 @@ package Sinfo is -- tree pointers (List1-4), the parent pointer of the Val node is set to -- point back to node N. This automates the setting of the parent pointer. + -- WARNING: There is a matching C declaration of a few subprograms in fe.h + procedure Set_Abort_Present (N : Node_Id; Val : Boolean := True); -- Flag15 @@ -11458,6 +11460,8 @@ package Sinfo is -- returns the location of the IF token in the END IF sequence by -- translating the value of the End_Span field. + -- WARNING: There is a matching C declaration of this subprogram in fe.h + procedure Set_End_Location (N : Node_Id; S : Source_Ptr); -- N is an N_If_Statement or N_Case_Statement node. This procedure sets -- the End_Span field to correspond to the given value S. In other words, diff --git a/gcc/ada/sinput.ads b/gcc/ada/sinput.ads index 0ef781c..c968eed 100644 --- a/gcc/ada/sinput.ads +++ b/gcc/ada/sinput.ads @@ -293,6 +293,8 @@ package Sinput is -- will be 1 since system.ads is read first. function Debug_Source_Name (S : SFI) return File_Name_Type; + -- WARNING: There is a matching C declaration of this subprogram in fe.h + function File_Name (S : SFI) return File_Name_Type; function File_Type (S : SFI) return Type_Of_File; function First_Mapped_Line (S : SFI) return Logical_Line_Number; @@ -532,6 +534,8 @@ package Sinput is -- determined and returned. Tab characters if present are assumed to -- represent the standard 1,9,17.. spacing pattern. + -- WARNING: There is a matching C declaration of this subprogram in fe.h + function Get_Logical_Line_Number (P : Source_Ptr) return Logical_Line_Number; -- The line number of the specified source position is obtained by @@ -543,6 +547,8 @@ package Sinput is -- reference pragmas have been encountered, the value returned is -- the same as the physical line number. + -- WARNING: There is a matching C declaration of this subprogram in fe.h + function Get_Logical_Line_Number_Img (P : Source_Ptr) return String; -- Same as above function, but returns the line number as a string of @@ -561,6 +567,8 @@ package Sinput is -- value. This call must always succeed, since any valid source pointer -- value belongs to some previously loaded source file. + -- WARNING: There is a matching C declaration of this subprogram in fe.h + function Instantiation_Depth (S : Source_Ptr) return Nat; -- Determine instantiation depth for given Sloc value. A value of -- zero means that the given Sloc is not in an instantiation. diff --git a/gcc/ada/stringt.ads b/gcc/ada/stringt.ads index 722d17f..2ceb20c 100644 --- a/gcc/ada/stringt.ads +++ b/gcc/ada/stringt.ads @@ -42,6 +42,9 @@ package Stringt is -- additional string constants generated by compile time concatenation and -- other similar processing. +-- WARNING: There is a C version of this package. Any changes to this +-- source file must be properly reflected in the C header file stringt.h + -- A string constant in this table consists of a series of Char_Code values, -- so that 16-bit character codes can be properly handled if this feature -- is implemented in the scanner. diff --git a/gcc/ada/stringt.h b/gcc/ada/stringt.h index 371acdf..911c61b 100644 --- a/gcc/ada/stringt.h +++ b/gcc/ada/stringt.h @@ -23,8 +23,10 @@ * * ****************************************************************************/ -/* This file is the C file that corresponds to the Ada package spec - Stringt. It was created manually from stringt.ads and stringt.adb +/* This is the C header that corresponds to the Ada package specification for + Stringt. It also contains the implementations of inlined functions from the + package body for Stringt. It was created manually from stringt.ads and + stringt.adb and must be kept synchronized with changes in these files. Note: only the access functions are provided, since the tree transformer is not allowed to modify the tree or its auxiliary structures. diff --git a/gcc/ada/targparm.ads b/gcc/ada/targparm.ads index e8139ba..d9465b5 100644 --- a/gcc/ada/targparm.ads +++ b/gcc/ada/targparm.ads @@ -455,12 +455,16 @@ package Targparm is Stack_Check_Probes_On_Target : Boolean := False; -- Indicates if the GCC probing mechanism is used + -- WARNING: There is a matching C declaration of this variable in fe.h + Stack_Check_Limits_On_Target : Boolean := False; -- Indicates if the GCC stack-limit mechanism is used -- Both flags cannot be simultaneously set to True. If neither -- is, the target independent fallback method is used. + -- WARNING: There is a matching C declaration of this variable in fe.h + Stack_Check_Default_On_Target : Boolean := False; -- Indicates if stack checking is on by default @@ -536,9 +540,13 @@ package Targparm is Machine_Overflows_On_Target : Boolean := False; -- Set to True for targets where S'Machine_Overflows is True + -- WARNING: There is a matching C declaration of this variable in fe.h + Signed_Zeros_On_Target : Boolean := True; -- Set to False on targets that do not reliably support signed zeros + -- WARNING: There is a matching C declaration of this variable in fe.h + ------------------------------------------- -- Boolean-Valued Fixed-Point Attributes -- ------------------------------------------- diff --git a/gcc/ada/types.ads b/gcc/ada/types.ads index 1297451..e649c4e 100644 --- a/gcc/ada/types.ads +++ b/gcc/ada/types.ads @@ -38,7 +38,7 @@ -- would have to be dealt with. -- WARNING: There is a C version of this package. Any changes to this source --- file must be properly reflected in the C header file types.h declarations. +-- file must be properly reflected in the C header file types.h -- Note: the declarations in this package reflect an expectation that the host -- machine has an efficient integer base type with a range at least 32 bits diff --git a/gcc/ada/types.h b/gcc/ada/types.h index 94dc22c..a87340d 100644 --- a/gcc/ada/types.h +++ b/gcc/ada/types.h @@ -23,8 +23,9 @@ * * ****************************************************************************/ -/* This is the C file that corresponds to the Ada package spec Types. It was - created manually from the files types.ads and types.adb. +/* This is the C header that corresponds to the Ada package specification for + Types. It was created manually from types.ads and must be kept synchronized + with changes in this file. This package contains host independent type definitions which are used throughout the compiler modules. The comments in the C version are brief @@ -306,6 +307,9 @@ typedef Int Unit_Number_Type; /* Unit number value for main unit. */ #define Main_Unit 0 +/* Type used to index the source file table. */ +typedef Nat Source_File_Index; + /* Type used for lines table. */ typedef Source_Ptr *Lines_Table_Type; diff --git a/gcc/ada/uintp.h b/gcc/ada/uintp.h index ad1b8c5..ed106ef 100644 --- a/gcc/ada/uintp.h +++ b/gcc/ada/uintp.h @@ -23,8 +23,9 @@ * * ****************************************************************************/ -/* This file corresponds to the Ada package specification Uintp. It was - created manually from the files uintp.ads and uintp.adb. */ +/* This is the C header that corresponds to the Ada package specification for + Uintp. It was created manually from uintp.ads and must be kept synchronized + with changes in this file. */ #ifdef __cplusplus extern "C" { diff --git a/gcc/ada/urealp.ads b/gcc/ada/urealp.ads index 585d894..55a82f2 100644 --- a/gcc/ada/urealp.ads +++ b/gcc/ada/urealp.ads @@ -31,6 +31,9 @@ -- Support for universal real arithmetic +-- WARNING: There is a C version of this package. Any changes to this +-- source file must be properly reflected in the C header file urealp.h + with Types; use Types; with Uintp; use Uintp; diff --git a/gcc/ada/urealp.h b/gcc/ada/urealp.h index 413e710..ab8656b 100644 --- a/gcc/ada/urealp.h +++ b/gcc/ada/urealp.h @@ -23,8 +23,9 @@ * * ****************************************************************************/ -/* This file corresponds to the Ada package specification Urealp. It was - created manually from the files urealp.ads and urealp.adb. */ +/* This is the C header that corresponds to the Ada package specification for + Urealp. It was created manually from urealp.ads and must be kept + synchronized with changes in this file. */ #ifdef __cplusplus extern "C" { diff --git a/gcc/ada/warnsw.ads b/gcc/ada/warnsw.ads index 0a3253e..c82f36d 100644 --- a/gcc/ada/warnsw.ads +++ b/gcc/ada/warnsw.ads @@ -63,6 +63,8 @@ package Warnsw is -- efficiency reasons and would be improved by reordering the components. -- Off by default, modified by use of -gnatw.q/.Q (but not -gnatwa). + -- WARNING: There is a matching C declaration of this variable in fe.h + Warn_On_Record_Holes : Boolean := False; -- Warn when explicit record component clauses leave uncovered holes (gaps) -- in a record layout. Off by default, set by -gnatw.h (but not -gnatwa). -- cgit v1.1 From f48a35ca9cda25c6fe400fae6d5e4ad1c0d0804a Mon Sep 17 00:00:00 2001 From: Arnaud Charlet Date: Thu, 12 Dec 2019 10:01:51 +0000 Subject: [Ada] Remove references to VMS 2019-12-12 Arnaud Charlet gcc/ada/ * raise-gcc.c: Remove references to VMS From-SVN: r279279 --- gcc/ada/ChangeLog | 4 +++ gcc/ada/raise-gcc.c | 75 +++-------------------------------------------------- 2 files changed, 7 insertions(+), 72 deletions(-) (limited to 'gcc/ada') diff --git a/gcc/ada/ChangeLog b/gcc/ada/ChangeLog index 4823313..c57674e 100644 --- a/gcc/ada/ChangeLog +++ b/gcc/ada/ChangeLog @@ -1,3 +1,7 @@ +2019-12-12 Arnaud Charlet + + * raise-gcc.c: Remove references to VMS + 2019-12-12 Eric Botcazou * atree.ads, comperr.ads, debug.ads, einfo.ads, elists.ads, diff --git a/gcc/ada/raise-gcc.c b/gcc/ada/raise-gcc.c index c15547d..a77b731 100644 --- a/gcc/ada/raise-gcc.c +++ b/gcc/ada/raise-gcc.c @@ -889,7 +889,7 @@ get_call_site_action_for (_Unwind_Ptr ip, argument, and PROPAGATED_EXCEPTION a pointer to the currently propagated occurrence, return true if the latter matches the former, that is, if PROPAGATED_EXCEPTION is caught by the handling code controlled by CHOICE. - This takes care of the special Non_Ada_Error case on VMS. */ +*/ #define Is_Handled_By_Others __gnat_is_handled_by_others #define Language_For __gnat_language_for @@ -906,11 +906,6 @@ extern Exception_Id EID_For (_GNAT_Exception * e); #define Foreign_Exception system__exceptions__foreign_exception extern struct Exception_Data Foreign_Exception; -#ifdef VMS -#define Non_Ada_Error system__aux_dec__non_ada_error -extern struct Exception_Data Non_Ada_Error; -#endif - /* Return true iff the exception class of EXCEPT is EC. */ static int @@ -951,23 +946,6 @@ is_handled_by (_Unwind_Ptr choice, _GNAT_Exception *propagated_exception) if (choice == E || (choice == GNAT_OTHERS && Is_Handled_By_Others (E))) return handler; -#ifdef VMS - /* In addition, on OpenVMS, Non_Ada_Error matches VMS exceptions, and we - may have different exception data pointers that should match for the - same condition code, if both an export and an import have been - registered. The import code for both the choice and the propagated - occurrence are expected to have been masked off regarding severity - bits already (at registration time for the former and from within the - low level exception vector for the latter). */ - if ((Language_For (E) == 'V' - && choice != GNAT_OTHERS - && ((Language_For (choice) == 'V' - && Foreign_Data_For (choice) != 0 - && Foreign_Data_For (choice) == Foreign_Data_For (E)) - || choice == (_Unwind_Ptr)&Non_Ada_Error))) - return handler; -#endif - /* Otherwise, it doesn't match an Ada choice. */ return nothing; } @@ -1271,36 +1249,8 @@ personality_body (_Unwind_Action uw_phases, } #ifndef __ARM_EABI_UNWINDER__ -/* Major tweak for ia64-vms : the CHF propagation phase calls this personality - routine with sigargs/mechargs arguments and has very specific expectations - on possible return values. - - We handle this with a number of specific tricks: - - 1. We tweak the personality routine prototype to have the "version" and - "phases" two first arguments be void * instead of int and _Unwind_Action - as nominally expected in the GCC context. - - This allows us to access the full range of bits passed in every case and - has no impact on the callers side since each argument remains assigned - the same single 64bit slot. - - 2. We retrieve the corresponding int and _Unwind_Action values within the - routine for regular use with truncating conversions. This is a noop when - called from the libgcc unwinder. - - 3. We assume we're called by the VMS CHF when unexpected bits are set in - both those values. The incoming arguments are then real sigargs and - mechargs pointers, which we then redirect to __gnat_handle_vms_condition - for proper processing. -*/ -#if defined (VMS) && defined (__IA64) -typedef void * version_arg_t; -typedef void * phases_arg_t; -#else typedef int version_arg_t; typedef _Unwind_Action phases_arg_t; -#endif PERSONALITY_STORAGE _Unwind_Reason_Code PERSONALITY_FUNCTION (version_arg_t, phases_arg_t, @@ -1321,28 +1271,9 @@ PERSONALITY_FUNCTION (version_arg_t version_arg, int uw_version = (int) version_arg; _Unwind_Action uw_phases = (_Unwind_Action) phases_arg; - /* Check that we're called from the ABI context we expect, with a major - possible variation on VMS for IA64. */ + /* Check that we're called from the ABI context we expect. */ if (uw_version != 1) - { -#if defined (VMS) && defined (__IA64) - - /* Assume we're called with sigargs/mechargs arguments if really - unexpected bits are set in our first two formals. Redirect to the - GNAT condition handling code in this case. */ - - extern long __gnat_handle_vms_condition (void *, void *); - - unsigned int version_unexpected_bits_mask = 0xffffff00U; - unsigned int phases_unexpected_bits_mask = 0xffffff00U; - - if ((unsigned int)uw_version & version_unexpected_bits_mask - && (unsigned int)uw_phases & phases_unexpected_bits_mask) - return __gnat_handle_vms_condition (version_arg, phases_arg); -#endif - - return _URC_FATAL_PHASE1_ERROR; - } + return _URC_FATAL_PHASE1_ERROR; return personality_body (uw_phases, uw_exception, uw_context); } -- cgit v1.1 From 87b66149a315e0e0bc80a1075ce6da615fe55199 Mon Sep 17 00:00:00 2001 From: Justin Squirek Date: Thu, 12 Dec 2019 10:01:55 +0000 Subject: [Ada] Crash on use of Loop_Entry, Result, and Old as actuals 2019-12-12 Justin Squirek gcc/ada/ * exp_ch6.adb (Expand_Call_Helper): Added null case for 'Loop_Entry, 'Old, and 'Result when calculating whether to create extra accessibility parameters. * sem_util.adb (Dynamic_Accessibility_Level): Added null case for 'Loop_Entry, 'Old, and 'Result when calculating accessibility level based on access-valued attributes. Also added special handling for uses of 'Loop_Entry when used in its indexed component form. From-SVN: r279280 --- gcc/ada/ChangeLog | 11 +++++++++++ gcc/ada/exp_ch6.adb | 9 +++++++++ gcc/ada/sem_util.adb | 24 +++++++++++++++++++++++- 3 files changed, 43 insertions(+), 1 deletion(-) (limited to 'gcc/ada') diff --git a/gcc/ada/ChangeLog b/gcc/ada/ChangeLog index c57674e..7343430 100644 --- a/gcc/ada/ChangeLog +++ b/gcc/ada/ChangeLog @@ -1,3 +1,14 @@ +2019-12-12 Justin Squirek + + * exp_ch6.adb (Expand_Call_Helper): Added null case for + 'Loop_Entry, 'Old, and 'Result when calculating whether to + create extra accessibility parameters. + * sem_util.adb (Dynamic_Accessibility_Level): Added null case + for 'Loop_Entry, 'Old, and 'Result when calculating + accessibility level based on access-valued attributes. Also + added special handling for uses of 'Loop_Entry when used in its + indexed component form. + 2019-12-12 Arnaud Charlet * raise-gcc.c: Remove references to VMS diff --git a/gcc/ada/exp_ch6.adb b/gcc/ada/exp_ch6.adb index b311322..3d6ef48 100644 --- a/gcc/ada/exp_ch6.adb +++ b/gcc/ada/exp_ch6.adb @@ -3389,6 +3389,15 @@ package body Exp_Ch6 is case Nkind (Prev_Orig) is when N_Attribute_Reference => case Get_Attribute_Id (Attribute_Name (Prev_Orig)) is + -- Ignore 'Result, 'Loop_Entry, and 'Old as they can + -- be used to identify access objects and do not have + -- an effect on accessibility level. + + when Attribute_Loop_Entry + | Attribute_Old + | Attribute_Result + => + null; -- For X'Access, pass on the level of the prefix X diff --git a/gcc/ada/sem_util.adb b/gcc/ada/sem_util.adb index 4de41d3e..c7dabdd 100644 --- a/gcc/ada/sem_util.adb +++ b/gcc/ada/sem_util.adb @@ -6488,7 +6488,7 @@ package body Sem_Util is -- Local variables - Expr : constant Node_Id := Original_Node (N); + Expr : Node_Id := Original_Node (N); -- Expr references the original node because at this stage N may be the -- reference to a variable internally created by the frontend to remove -- side effects of an expression. @@ -6516,6 +6516,21 @@ package body Sem_Util is -- Unimplemented: Ptr.all'Access, where Ptr has Extra_Accessibility ??? case Nkind (Expr) is + -- It may be possible that we have an access object denoted by an + -- attribute reference for 'Loop_Entry which may, in turn, have an + -- indexed component representing a loop identifier. + + -- In this case we must climb up the indexed component and set expr + -- to the attribute reference so the rest of the machinery can + -- operate as expected. + + when N_Indexed_Component => + if Nkind (Prefix (Expr)) = N_Attribute_Reference + and then Get_Attribute_Id (Attribute_Name (Prefix (Expr))) + = Attribute_Loop_Entry + then + Expr := Prefix (Expr); + end if; -- For access discriminant, the level of the enclosing object @@ -6530,6 +6545,13 @@ package body Sem_Util is when N_Attribute_Reference => case Get_Attribute_Id (Attribute_Name (Expr)) is + -- Ignore 'Loop_Entry, 'Result, and 'Old as they can be used to + -- identify access objects and do not have an effect on + -- accessibility level. + + when Attribute_Loop_Entry | Attribute_Old | Attribute_Result => + null; + -- For X'Access, the level of the prefix X when Attribute_Access => -- cgit v1.1 From 605d816615bf239b9ca6627b18b861b0ff12eac0 Mon Sep 17 00:00:00 2001 From: Ed Schonberg Date: Thu, 12 Dec 2019 10:02:00 +0000 Subject: [Ada] Constraint is ignored on constrained access record component 2019-12-12 Ed Schonberg gcc/ada/ * sem_ch3.adb (Constrain_Access): Remove obsolete comments and warning concerning component types of an access type whose designated type is a constrained record type. (Such constraints were previously ignored). Set scope of itype for component to the scope of the enclosing record. * sem_ch4.adb: Remove call to Set_Ekind. * sem_util.adb (Build_Actual_Subtype_Of_Component): Handle components whose type is an access to a constrained discriminant, where the constraints may be given by the discriminants of the enclosing type. New subprogram Build_Access_Record_Constraint. gcc/testsuite/ * gnat.dg/warn24.adb: Remove expected warning. From-SVN: r279281 --- gcc/ada/ChangeLog | 14 +++++++ gcc/ada/sem_ch3.adb | 30 ++++++++++----- gcc/ada/sem_ch4.adb | 7 ++-- gcc/ada/sem_util.adb | 105 +++++++++++++++++++++++++++++++++++++++++++++++++-- 4 files changed, 139 insertions(+), 17 deletions(-) (limited to 'gcc/ada') diff --git a/gcc/ada/ChangeLog b/gcc/ada/ChangeLog index 7343430..c71233d 100644 --- a/gcc/ada/ChangeLog +++ b/gcc/ada/ChangeLog @@ -1,3 +1,17 @@ +2019-12-12 Ed Schonberg + + * sem_ch3.adb (Constrain_Access): Remove obsolete comments and + warning concerning component types of an access type whose + designated type is a constrained record type. (Such constraints + were previously ignored). Set scope of itype for component to + the scope of the enclosing record. + * sem_ch4.adb: Remove call to Set_Ekind. + * sem_util.adb (Build_Actual_Subtype_Of_Component): Handle + components whose type is an access to a constrained + discriminant, where the constraints may be given by the + discriminants of the enclosing type. New subprogram + Build_Access_Record_Constraint. + 2019-12-12 Justin Squirek * exp_ch6.adb (Expand_Call_Helper): Added null case for diff --git a/gcc/ada/sem_ch3.adb b/gcc/ada/sem_ch3.adb index b12f69b..bcee779 100644 --- a/gcc/ada/sem_ch3.adb +++ b/gcc/ada/sem_ch3.adb @@ -12971,29 +12971,39 @@ package body Sem_Ch3 is or else Is_Incomplete_Or_Private_Type (Desig_Type)) and then not Is_Constrained (Desig_Type) then - -- ??? The following code is a temporary bypass to ignore a - -- discriminant constraint on access type if it is constraining - -- the current record. Avoid creating the implicit subtype of the - -- record we are currently compiling since right now, we cannot - -- handle these. For now, just return the access type itself. + -- If this is a constrained access definition for a record + -- component, we leave the type as an unconstrained access, + -- and mark the component so that its actual type is build + -- at a point of use (e.g an assignment statement). THis is + -- handled in sem_util, Build_Actual_Subtype_Of_Component. if Desig_Type = Current_Scope and then No (Def_Id) then - Error_Msg_Warn := SPARK_Mode /= On; - Error_Msg_N ("< Scope (Desig_Type)); Set_Ekind (Desig_Subtype, E_Record_Subtype); Def_Id := Entity (Subtype_Mark (S)); + -- We indicate that the component has a pet-object + -- constraint for uniform treatment at a point of use, + -- even though the constraint may be independent of + -- discriminants of enclosing type. + + if Nkind (Related_Nod) = N_Component_Declaration then + Set_Has_Per_Object_Constraint + (Defining_Identifier (Related_Nod)); + end if; + -- This call added to ensure that the constraint is analyzed -- (needed for a B test). Note that we still return early from - -- this procedure to avoid recursive processing. ??? + -- this procedure to avoid recursive processing. Constrain_Discriminated_Type (Desig_Subtype, S, Related_Nod, For_Access => True); return; + end if; -- Enforce rule that the constraint is illegal if there is an diff --git a/gcc/ada/sem_ch4.adb b/gcc/ada/sem_ch4.adb index 313398a..0890539 100644 --- a/gcc/ada/sem_ch4.adb +++ b/gcc/ada/sem_ch4.adb @@ -4812,16 +4812,15 @@ package body Sem_Ch4 is Set_Etype (N, Etype (Comp)); else - -- Component type depends on discriminants. Enter the - -- main attributes of the subtype. + -- If discriminants were present in the component + -- declaration, they have been replaced by the + -- actual values in the prefix object. declare Subt : constant Entity_Id := Defining_Identifier (Act_Decl); - begin Set_Etype (Subt, Base_Type (Etype (Comp))); - Set_Ekind (Subt, Ekind (Etype (Comp))); Set_Etype (N, Subt); end; end if; diff --git a/gcc/ada/sem_util.adb b/gcc/ada/sem_util.adb index c7dabdd..5d5c520 100644 --- a/gcc/ada/sem_util.adb +++ b/gcc/ada/sem_util.adb @@ -1187,18 +1187,28 @@ package body Sem_Util is is Loc : constant Source_Ptr := Sloc (N); P : constant Node_Id := Prefix (N); + D : Elmt_Id; Id : Node_Id; Index_Typ : Entity_Id; + Sel : Entity_Id := Empty; Desig_Typ : Entity_Id; -- This is either a copy of T, or if T is an access type, then it is -- the directly designated type of this access type. + function Build_Access_Record_Constraint (C : List_Id) return List_Id; + -- If the record component is a constrained access to the current + -- record, the subtype has not been constructed during analysis of + -- the enclosing record type (see Analyze_Access). In that case build + -- a constrainted access subtype after replacing references to the + -- enclosing discriminants by the corresponding discriminant values + -- of the prefix. + function Build_Actual_Array_Constraint return List_Id; -- If one or more of the bounds of the component depends on -- discriminants, build actual constraint using the discriminants - -- of the prefix. + -- of the prefx, as above. function Build_Actual_Record_Constraint return List_Id; -- Similar to previous one, for discriminated components constrained @@ -1286,10 +1296,53 @@ package body Sem_Util is return Constraints; end Build_Actual_Record_Constraint; + ------------------------------------ + -- Build_Access_Record_Constraint -- + ------------------------------------ + + function Build_Access_Record_Constraint (C : List_Id) return List_Id is + Constraints : constant List_Id := New_List; + D : Node_Id; + D_Val : Node_Id; + + begin + -- Retrieve the constraint from the compomnent declaration, because + -- the component subtype has not been constructed and the component + -- type is an unconstrained access. + + D := First (C); + while Present (D) loop + if Nkind (D) = N_Discriminant_Association + and then Denotes_Discriminant (Expression (D)) + then + D_Val := New_Copy_Tree (D); + Set_Expression (D_Val, + Make_Selected_Component (Loc, + Prefix => New_Copy_Tree (P), + Selector_Name => + New_Occurrence_Of (Entity (Expression (D)), Loc))); + + elsif Denotes_Discriminant (D) then + D_Val := Make_Selected_Component (Loc, + Prefix => New_Copy_Tree (P), + Selector_Name => New_Occurrence_Of (Entity (D), Loc)); + + else + D_Val := New_Copy_Tree (D); + end if; + + Append (D_Val, Constraints); + Next (D); + end loop; + + return Constraints; + end Build_Access_Record_Constraint; + -- Start of processing for Build_Actual_Subtype_Of_Component begin - -- Why the test for Spec_Expression mode here??? + -- The subtype does not need to be created for a selected component + -- in a Spec_Expression, if In_Spec_Expression then return Empty; @@ -1314,19 +1367,33 @@ package body Sem_Util is Remove_Side_Effects (P); return Build_Actual_Subtype (T, N); end if; + else return Empty; end if; + + elsif Nkind (N) = N_Selected_Component then + -- THe entity of the selected compomnent allows us to retrieve + -- the original constraint from its component declaration. + + Sel := Entity (Selector_Name (N)); + if Nkind (Parent (Sel)) /= N_Component_Declaration then + return Empty; + end if; end if; - if Ekind (T) = E_Access_Subtype then + if Is_Access_Type (T) then Desig_Typ := Designated_Type (T); + else Desig_Typ := T; end if; if Ekind (Desig_Typ) = E_Array_Subtype then Id := First_Index (Desig_Typ); + + -- Check whether an index bound is constrained by a discriminant. + while Present (Id) loop Index_Typ := Underlying_Type (Etype (Id)); @@ -1345,6 +1412,7 @@ package body Sem_Util is elsif Is_Composite_Type (Desig_Typ) and then Has_Discriminants (Desig_Typ) + and then not Is_Empty_Elmt_List (Discriminant_Constraint (Desig_Typ)) and then not Has_Unknown_Discriminants (Desig_Typ) then if Is_Private_Type (Desig_Typ) @@ -1364,6 +1432,37 @@ package body Sem_Util is Next_Elmt (D); end loop; + + -- Special processing for an access record component that is + -- the target of an assignment. If the designated type is an + -- unconstrained discriminated record we create its actual + -- subtype now. + + elsif Ekind (T) = E_Access_Type + and then Present (Sel) + and then Has_Per_Object_Constraint (Sel) + and then Nkind (Parent (N)) = N_Assignment_Statement + and then N = Name (Parent (N)) + -- and then not Inside_Init_Proc + -- and then Has_Discriminants (Desig_Typ) + -- and then not Is_Constrained (Desig_Typ) + then + declare + S_Indic : constant Node_Id := + (Subtype_Indication + (Component_Definition (Parent (Sel)))); + Discs : List_Id; + begin + if Nkind (S_Indic) = N_Subtype_Indication then + Discs := Constraints (Constraint (S_Indic)); + + Remove_Side_Effects (P); + return Build_Component_Subtype + (Build_Access_Record_Constraint (Discs), Loc, T); + else + return Empty; + end if; + end; end if; -- If none of the above, the actual and nominal subtypes are the same -- cgit v1.1 From d5461bed9a1b19840030d47c5ce9b685cd1206c5 Mon Sep 17 00:00:00 2001 From: Bob Duff Date: Thu, 12 Dec 2019 10:02:05 +0000 Subject: [Ada] Update gnatmetric documentation for average lengths 2019-12-12 Bob Duff gcc/ada/ * doc/gnat_ugn/gnat_utility_programs.rst: Update gnatmetric documentation for average lengths From-SVN: r279282 --- gcc/ada/ChangeLog | 5 +++++ gcc/ada/doc/gnat_ugn/gnat_utility_programs.rst | 6 ++---- 2 files changed, 7 insertions(+), 4 deletions(-) (limited to 'gcc/ada') diff --git a/gcc/ada/ChangeLog b/gcc/ada/ChangeLog index c71233d..57df9a2 100644 --- a/gcc/ada/ChangeLog +++ b/gcc/ada/ChangeLog @@ -1,3 +1,8 @@ +2019-12-12 Bob Duff + + * doc/gnat_ugn/gnat_utility_programs.rst: Update gnatmetric + documentation for average lengths + 2019-12-12 Ed Schonberg * sem_ch3.adb (Constrain_Access): Remove obsolete comments and diff --git a/gcc/ada/doc/gnat_ugn/gnat_utility_programs.rst b/gcc/ada/doc/gnat_ugn/gnat_utility_programs.rst index 56d4869..6e836a7 100644 --- a/gcc/ada/doc/gnat_ugn/gnat_utility_programs.rst +++ b/gcc/ada/doc/gnat_ugn/gnat_utility_programs.rst @@ -2022,8 +2022,7 @@ Alternatively, you may run the script using the following command line: and/or format effectors (blank lines) * the average number of code lines in subprogram bodies, task bodies, - entry bodies and statement sequences in package bodies (this metric - is only computed across the whole set of the analyzed units) + entry bodies and statement sequences in package bodies ``gnatmetric`` sums the values of the line metrics for all the files being processed and then generates the cumulative results. The tool @@ -2098,8 +2097,7 @@ Alternatively, you may run the script using the following command line: :switch:`--lines-average` Report the average number of code lines in subprogram bodies, task bodies, - entry bodies and statement sequences in package bodies. The metric is - reported for the whole set of processed Ada sources only. + entry bodies and statement sequences in package bodies. :switch:`--no-lines-average` -- cgit v1.1 From e16c6cc3319d1ee613a9c53b86d2e7addd07b13c Mon Sep 17 00:00:00 2001 From: Gary Dismukes Date: Thu, 12 Dec 2019 10:02:09 +0000 Subject: [Ada] Fix a number of typos, plus minor reformatting 2019-12-12 Gary Dismukes gcc/ada/ * sem_ch3.adb, sem_util.adb: Minor reformatting. From-SVN: r279283 --- gcc/ada/ChangeLog | 4 ++++ gcc/ada/sem_ch3.adb | 14 ++++++-------- gcc/ada/sem_util.adb | 18 +++++++++--------- 3 files changed, 19 insertions(+), 17 deletions(-) (limited to 'gcc/ada') diff --git a/gcc/ada/ChangeLog b/gcc/ada/ChangeLog index 57df9a2..3d0ede4 100644 --- a/gcc/ada/ChangeLog +++ b/gcc/ada/ChangeLog @@ -1,3 +1,7 @@ +2019-12-12 Gary Dismukes + + * sem_ch3.adb, sem_util.adb: Minor reformatting. + 2019-12-12 Bob Duff * doc/gnat_ugn/gnat_utility_programs.rst: Update gnatmetric diff --git a/gcc/ada/sem_ch3.adb b/gcc/ada/sem_ch3.adb index bcee779..c3b8796 100644 --- a/gcc/ada/sem_ch3.adb +++ b/gcc/ada/sem_ch3.adb @@ -12973,9 +12973,9 @@ package body Sem_Ch3 is then -- If this is a constrained access definition for a record -- component, we leave the type as an unconstrained access, - -- and mark the component so that its actual type is build - -- at a point of use (e.g an assignment statement). THis is - -- handled in sem_util, Build_Actual_Subtype_Of_Component. + -- and mark the component so that its actual type is built + -- at a point of use (e.g., an assignment statement). This + -- is handled in Sem_Util.Build_Actual_Subtype_Of_Component. if Desig_Type = Current_Scope and then No (Def_Id) @@ -12986,10 +12986,9 @@ package body Sem_Ch3 is Set_Ekind (Desig_Subtype, E_Record_Subtype); Def_Id := Entity (Subtype_Mark (S)); - -- We indicate that the component has a pet-object - -- constraint for uniform treatment at a point of use, - -- even though the constraint may be independent of - -- discriminants of enclosing type. + -- We indicate that the component has a per-object constraint + -- for treatment at a point of use, even though the constraint + -- may be independent of discriminants of the enclosing type. if Nkind (Related_Nod) = N_Component_Declaration then Set_Has_Per_Object_Constraint @@ -13003,7 +13002,6 @@ package body Sem_Ch3 is Constrain_Discriminated_Type (Desig_Subtype, S, Related_Nod, For_Access => True); return; - end if; -- Enforce rule that the constraint is illegal if there is an diff --git a/gcc/ada/sem_util.adb b/gcc/ada/sem_util.adb index 5d5c520..22ecf21 100644 --- a/gcc/ada/sem_util.adb +++ b/gcc/ada/sem_util.adb @@ -1200,15 +1200,15 @@ package body Sem_Util is function Build_Access_Record_Constraint (C : List_Id) return List_Id; -- If the record component is a constrained access to the current -- record, the subtype has not been constructed during analysis of - -- the enclosing record type (see Analyze_Access). In that case build - -- a constrainted access subtype after replacing references to the - -- enclosing discriminants by the corresponding discriminant values + -- the enclosing record type (see Analyze_Access). In that case, build + -- a constrained access subtype after replacing references to the + -- enclosing discriminants with the corresponding discriminant values -- of the prefix. function Build_Actual_Array_Constraint return List_Id; -- If one or more of the bounds of the component depends on -- discriminants, build actual constraint using the discriminants - -- of the prefx, as above. + -- of the prefix, as above. function Build_Actual_Record_Constraint return List_Id; -- Similar to previous one, for discriminated components constrained @@ -1306,7 +1306,7 @@ package body Sem_Util is D_Val : Node_Id; begin - -- Retrieve the constraint from the compomnent declaration, because + -- Retrieve the constraint from the component declaration, because -- the component subtype has not been constructed and the component -- type is an unconstrained access. @@ -1319,13 +1319,13 @@ package body Sem_Util is Set_Expression (D_Val, Make_Selected_Component (Loc, Prefix => New_Copy_Tree (P), - Selector_Name => + Selector_Name => New_Occurrence_Of (Entity (Expression (D)), Loc))); elsif Denotes_Discriminant (D) then D_Val := Make_Selected_Component (Loc, Prefix => New_Copy_Tree (P), - Selector_Name => New_Occurrence_Of (Entity (D), Loc)); + Selector_Name => New_Occurrence_Of (Entity (D), Loc)); else D_Val := New_Copy_Tree (D); @@ -1342,7 +1342,7 @@ package body Sem_Util is begin -- The subtype does not need to be created for a selected component - -- in a Spec_Expression, + -- in a Spec_Expression. if In_Spec_Expression then return Empty; @@ -1373,7 +1373,7 @@ package body Sem_Util is end if; elsif Nkind (N) = N_Selected_Component then - -- THe entity of the selected compomnent allows us to retrieve + -- The entity of the selected component allows us to retrieve -- the original constraint from its component declaration. Sel := Entity (Selector_Name (N)); -- cgit v1.1 From d878b2c9819e0ae9e942c87c3eb547b0bfb30dc5 Mon Sep 17 00:00:00 2001 From: Claire Dross Date: Thu, 12 Dec 2019 10:02:14 +0000 Subject: [Ada] Use correct subtype for call to Last in formal vectors 2019-12-12 Claire Dross gcc/ada/ * libgnat/a-cofove.adb, libgnat/a-cfinve.adb (Find_Index): Use Extended_Index for call to Last. From-SVN: r279284 --- gcc/ada/ChangeLog | 5 +++++ gcc/ada/libgnat/a-cfinve.adb | 2 +- gcc/ada/libgnat/a-cofove.adb | 2 +- 3 files changed, 7 insertions(+), 2 deletions(-) (limited to 'gcc/ada') diff --git a/gcc/ada/ChangeLog b/gcc/ada/ChangeLog index 3d0ede4..99b142c 100644 --- a/gcc/ada/ChangeLog +++ b/gcc/ada/ChangeLog @@ -1,3 +1,8 @@ +2019-12-12 Claire Dross + + * libgnat/a-cofove.adb, libgnat/a-cfinve.adb (Find_Index): Use + Extended_Index for call to Last. + 2019-12-12 Gary Dismukes * sem_ch3.adb, sem_util.adb: Minor reformatting. diff --git a/gcc/ada/libgnat/a-cfinve.adb b/gcc/ada/libgnat/a-cfinve.adb index a187128..b5c318b 100644 --- a/gcc/ada/libgnat/a-cfinve.adb +++ b/gcc/ada/libgnat/a-cfinve.adb @@ -458,7 +458,7 @@ is Index : Index_Type := Index_Type'First) return Extended_Index is K : Count_Type; - Last : constant Index_Type := Last_Index (Container); + Last : constant Extended_Index := Last_Index (Container); begin K := Capacity_Range (Int (Index) - Int (No_Index)); diff --git a/gcc/ada/libgnat/a-cofove.adb b/gcc/ada/libgnat/a-cofove.adb index 3a10d32..1240a50 100644 --- a/gcc/ada/libgnat/a-cofove.adb +++ b/gcc/ada/libgnat/a-cofove.adb @@ -379,7 +379,7 @@ is Index : Index_Type := Index_Type'First) return Extended_Index is K : Count_Type; - Last : constant Index_Type := Last_Index (Container); + Last : constant Extended_Index := Last_Index (Container); begin K := Capacity_Range (Int (Index) - Int (No_Index)); -- cgit v1.1 From 0e3a687f8c5351a52f48c4062c2cf88cdc7d4424 Mon Sep 17 00:00:00 2001 From: Bob Duff Date: Thu, 12 Dec 2019 10:02:19 +0000 Subject: [Ada] Compiler crash on prefix call in generic body 2019-12-12 Bob Duff gcc/ada/ * sem_ch4.adb (Transform_Object_Operation): Deal properly with prefix notation in instances. From-SVN: r279285 --- gcc/ada/ChangeLog | 5 +++ gcc/ada/sem_ch4.adb | 91 ++++++++++++++++++++++++++--------------------------- 2 files changed, 50 insertions(+), 46 deletions(-) (limited to 'gcc/ada') diff --git a/gcc/ada/ChangeLog b/gcc/ada/ChangeLog index 99b142c..150ee56 100644 --- a/gcc/ada/ChangeLog +++ b/gcc/ada/ChangeLog @@ -1,3 +1,8 @@ +2019-12-12 Bob Duff + + * sem_ch4.adb (Transform_Object_Operation): Deal properly with + prefix notation in instances. + 2019-12-12 Claire Dross * libgnat/a-cofove.adb, libgnat/a-cfinve.adb (Find_Index): Use diff --git a/gcc/ada/sem_ch4.adb b/gcc/ada/sem_ch4.adb index 0890539..03c7440 100644 --- a/gcc/ada/sem_ch4.adb +++ b/gcc/ada/sem_ch4.adb @@ -8574,7 +8574,7 @@ package body Sem_Ch4 is procedure Transform_Object_Operation (Call_Node : out Node_Id; Node_To_Replace : out Node_Id); - -- Transform Obj.Operation (X, Y,,) into Operation (Obj, X, Y ..) + -- Transform Obj.Operation (X, Y, ...) into Operation (Obj, X, Y ...). -- Call_Node is the resulting subprogram call, Node_To_Replace is -- either N or the parent of N, and Subprog is a reference to the -- subprogram we are trying to match. @@ -9299,7 +9299,7 @@ package body Sem_Ch4 is -- Prefix notation can also be used on operations that are not -- primitives of the type, but are declared in the same immediate -- declarative part, which can only mean the corresponding package - -- body (See RM 4.1.3 (9.2/3)). If we are in that body we extend the + -- body (see RM 4.1.3 (9.2/3)). If we are in that body we extend the -- list of primitives with body operations with the same name that -- may be candidates, so that Try_Primitive_Operations can examine -- them if no real primitive is found. @@ -9425,56 +9425,55 @@ package body Sem_Ch4 is function Extended_Primitive_Ops (T : Entity_Id) return Elist_Id is Type_Scope : constant Entity_Id := Scope (T); - - Body_Decls : List_Id; - Op_Found : Boolean; - Op : Entity_Id; - Op_List : Elist_Id; - + Op_List : Elist_Id := Primitive_Operations (T); begin - Op_List := Primitive_Operations (T); - - if Ekind (Type_Scope) = E_Package - and then In_Package_Body (Type_Scope) - and then In_Open_Scopes (Type_Scope) + if Ekind_In (Type_Scope, E_Package, E_Generic_Package) + and then ((In_Package_Body (Type_Scope) + and then In_Open_Scopes (Type_Scope)) or else In_Instance_Body) then - -- Retrieve list of declarations of package body. - - Body_Decls := - Declarations - (Unit_Declaration_Node - (Corresponding_Body - (Unit_Declaration_Node (Type_Scope)))); - - Op := Current_Entity (Subprog); - Op_Found := False; - while Present (Op) loop - if Comes_From_Source (Op) - and then Is_Overloadable (Op) - - -- Exclude overriding primitive operations of a type - -- extension declared in the package body, to prevent - -- duplicates in extended list. - - and then not Is_Primitive (Op) - and then Is_List_Member (Unit_Declaration_Node (Op)) - and then List_Containing (Unit_Declaration_Node (Op)) = - Body_Decls - then - if not Op_Found then + -- Retrieve list of declarations of package body if possible - -- Copy list of primitives so it is not affected for - -- other uses. + declare + The_Body : constant Node_Id := + Corresponding_Body (Unit_Declaration_Node (Type_Scope)); + begin + if Present (The_Body) then + declare + Body_Decls : constant List_Id := + Declarations (Unit_Declaration_Node (The_Body)); + Op_Found : Boolean := False; + Op : Entity_Id := Current_Entity (Subprog); + begin + while Present (Op) loop + if Comes_From_Source (Op) + and then Is_Overloadable (Op) + + -- Exclude overriding primitive operations of a + -- type extension declared in the package body, + -- to prevent duplicates in extended list. + + and then not Is_Primitive (Op) + and then Is_List_Member + (Unit_Declaration_Node (Op)) + and then List_Containing + (Unit_Declaration_Node (Op)) = Body_Decls + then + if not Op_Found then + -- Copy list of primitives so it is not + -- affected for other uses. - Op_List := New_Copy_Elist (Op_List); - Op_Found := True; - end if; + Op_List := New_Copy_Elist (Op_List); + Op_Found := True; + end if; - Append_Elmt (Op, Op_List); - end if; + Append_Elmt (Op, Op_List); + end if; - Op := Homonym (Op); - end loop; + Op := Homonym (Op); + end loop; + end; + end if; + end; end if; return Op_List; -- cgit v1.1 From c2f3e1a3e369fe549fa76e9821d2e17bc3d55dc7 Mon Sep 17 00:00:00 2001 From: Ed Schonberg Date: Thu, 12 Dec 2019 10:02:23 +0000 Subject: [Ada] Missing length check on private type with unknown discriminants 2019-12-12 Ed Schonberg gcc/ada/ * exp_ch5.adb (Expand_N_Assognment_Statement): Extend the processing involving private types with unknown discriminants to handle the case where the full view of the type is an unconstrained array type. From-SVN: r279286 --- gcc/ada/ChangeLog | 7 +++++++ gcc/ada/exp_ch5.adb | 23 ++++++++++++++++------- 2 files changed, 23 insertions(+), 7 deletions(-) (limited to 'gcc/ada') diff --git a/gcc/ada/ChangeLog b/gcc/ada/ChangeLog index 150ee56..a4dc138 100644 --- a/gcc/ada/ChangeLog +++ b/gcc/ada/ChangeLog @@ -1,3 +1,10 @@ +2019-12-12 Ed Schonberg + + * exp_ch5.adb (Expand_N_Assognment_Statement): Extend the + processing involving private types with unknown discriminants to + handle the case where the full view of the type is an + unconstrained array type. + 2019-12-12 Bob Duff * sem_ch4.adb (Transform_Object_Operation): Deal properly with diff --git a/gcc/ada/exp_ch5.adb b/gcc/ada/exp_ch5.adb index 4bbe86a..f3139bd 100644 --- a/gcc/ada/exp_ch5.adb +++ b/gcc/ada/exp_ch5.adb @@ -2409,14 +2409,23 @@ package body Exp_Ch5 is -- checking. Convert Lhs as well, otherwise the actual subtype might -- not be constructible. If the discriminants have defaults the type -- is unconstrained and there is nothing to check. + -- Ditto if a private type with unknown discriminants has a full view + -- that is an unconstrained array, in which case a length check is + -- needed. - elsif Has_Unknown_Discriminants (Base_Type (Etype (Lhs))) - and then Has_Discriminants (Typ) - and then not Has_Defaulted_Discriminants (Typ) - then - Rewrite (Rhs, OK_Convert_To (Base_Type (Typ), Rhs)); - Rewrite (Lhs, OK_Convert_To (Base_Type (Typ), Lhs)); - Apply_Discriminant_Check (Rhs, Typ, Lhs); + elsif Has_Unknown_Discriminants (Base_Type (Etype (Lhs))) then + if Has_Discriminants (Typ) + and then not Has_Defaulted_Discriminants (Typ) + then + Rewrite (Rhs, OK_Convert_To (Base_Type (Typ), Rhs)); + Rewrite (Lhs, OK_Convert_To (Base_Type (Typ), Lhs)); + Apply_Discriminant_Check (Rhs, Typ, Lhs); + + elsif Is_Array_Type (Typ) and then Is_Constrained (Typ) then + Rewrite (Rhs, OK_Convert_To (Base_Type (Typ), Rhs)); + Rewrite (Lhs, OK_Convert_To (Base_Type (Typ), Lhs)); + Apply_Length_Check (Rhs, Typ); + end if; -- In the access type case, we need the same discriminant check, and -- also range checks if we have an access to constrained array. -- cgit v1.1 From 5d3983bca523f337333cf6f749d6489014264572 Mon Sep 17 00:00:00 2001 From: Bob Duff Date: Thu, 12 Dec 2019 10:02:27 +0000 Subject: [Ada] Crash on Descriptor_Size attribute 2019-12-12 Bob Duff gcc/ada/ * sem_attr.adb (Eval_Attribute): Never mark T'Descriptor_Size as static, even if T is a static subtype, because otherwise we will request the value of the attribute, which will crash because we have not evaluated it. From-SVN: r279287 --- gcc/ada/ChangeLog | 7 +++++++ gcc/ada/sem_attr.adb | 3 +++ 2 files changed, 10 insertions(+) (limited to 'gcc/ada') diff --git a/gcc/ada/ChangeLog b/gcc/ada/ChangeLog index a4dc138..4ad9092 100644 --- a/gcc/ada/ChangeLog +++ b/gcc/ada/ChangeLog @@ -1,3 +1,10 @@ +2019-12-12 Bob Duff + + * sem_attr.adb (Eval_Attribute): Never mark T'Descriptor_Size as + static, even if T is a static subtype, because otherwise we will + request the value of the attribute, which will crash because we + have not evaluated it. + 2019-12-12 Ed Schonberg * exp_ch5.adb (Expand_N_Assognment_Statement): Extend the diff --git a/gcc/ada/sem_attr.adb b/gcc/ada/sem_attr.adb index 95de2e4..0cd8e08 100644 --- a/gcc/ada/sem_attr.adb +++ b/gcc/ada/sem_attr.adb @@ -7852,6 +7852,8 @@ package body Sem_Attr is -- is legal, since here this expression appears in a statically -- unevaluated position, so it does not actually raise an exception. + -- + -- T'Descriptor_Size is never static, even if T is static. if Is_Scalar_Type (P_Entity) and then (not Is_Generic_Type (P_Entity)) @@ -7865,6 +7867,7 @@ package body Sem_Attr is (No (E2) or else (Is_Static_Expression (E2) and then Is_Scalar_Type (Etype (E1)))) + and then Id /= Attribute_Descriptor_Size then Static := True; Set_Is_Static_Expression (N, True); -- cgit v1.1 From c171199011ac0d37df67ff99ea7286fa3455efcf Mon Sep 17 00:00:00 2001 From: Justin Squirek Date: Thu, 12 Dec 2019 10:02:32 +0000 Subject: [Ada] Missing error on incorrect use of Result attribute 2019-12-12 Justin Squirek gcc/ada/ * sem_attr.adb (Analyze_Attribute): Add error message for invalid usage of Attribute_Result. From-SVN: r279288 --- gcc/ada/ChangeLog | 5 +++++ gcc/ada/sem_attr.adb | 1 + 2 files changed, 6 insertions(+) (limited to 'gcc/ada') diff --git a/gcc/ada/ChangeLog b/gcc/ada/ChangeLog index 4ad9092..9e271ac 100644 --- a/gcc/ada/ChangeLog +++ b/gcc/ada/ChangeLog @@ -1,3 +1,8 @@ +2019-12-12 Justin Squirek + + * sem_attr.adb (Analyze_Attribute): Add error message for + invalid usage of Attribute_Result. + 2019-12-12 Bob Duff * sem_attr.adb (Eval_Attribute): Never mark T'Descriptor_Size as diff --git a/gcc/ada/sem_attr.adb b/gcc/ada/sem_attr.adb index 0cd8e08..e842293 100644 --- a/gcc/ada/sem_attr.adb +++ b/gcc/ada/sem_attr.adb @@ -5414,6 +5414,7 @@ package body Sem_Attr is Spec_Id := Entity (P); elsif not Legal then + Error_Attr ("prefix of % attribute must be a function", P); return; end if; -- cgit v1.1 From 182c8b7d2d43c71c92736bc37fe2a17545aa7776 Mon Sep 17 00:00:00 2001 From: Gary Dismukes Date: Thu, 12 Dec 2019 10:02:38 +0000 Subject: [Ada] Handling up-level references in protected entries and freeze nodes 2019-12-12 Gary Dismukes gcc/ada/ * exp_ch9.adb (Build_Protected_Entry): Analyze the block created to hold the declarations and statements of the protected entry body right after it's created, and then call Reset_Scopes_To on that block to reset the Scope of nested entities to the block scope. (Reset_Scope): Add handling for N_Freeze_Entity nodes, calling Reset_Scopes recursively on the Actions of such nodes. Also, for subprogram bodies that are encountered that might not have a separate declaration (such as type init procedures), reset the Scope of the subprogram's entity. From-SVN: r279289 --- gcc/ada/ChangeLog | 13 +++++++++++++ gcc/ada/exp_ch9.adb | 29 +++++++++++++++++++++++++++++ 2 files changed, 42 insertions(+) (limited to 'gcc/ada') diff --git a/gcc/ada/ChangeLog b/gcc/ada/ChangeLog index 9e271ac..f28fa45 100644 --- a/gcc/ada/ChangeLog +++ b/gcc/ada/ChangeLog @@ -1,3 +1,16 @@ +2019-12-12 Gary Dismukes + + * exp_ch9.adb (Build_Protected_Entry): Analyze the block created + to hold the declarations and statements of the protected entry + body right after it's created, and then call Reset_Scopes_To on + that block to reset the Scope of nested entities to the block + scope. + (Reset_Scope): Add handling for N_Freeze_Entity nodes, calling + Reset_Scopes recursively on the Actions of such nodes. Also, for + subprogram bodies that are encountered that might not have a + separate declaration (such as type init procedures), reset the + Scope of the subprogram's entity. + 2019-12-12 Justin Squirek * sem_attr.adb (Analyze_Attribute): Add error message for diff --git a/gcc/ada/exp_ch9.adb b/gcc/ada/exp_ch9.adb index 720c1a9..6e34de1 100644 --- a/gcc/ada/exp_ch9.adb +++ b/gcc/ada/exp_ch9.adb @@ -48,6 +48,7 @@ with Rident; use Rident; with Rtsfind; use Rtsfind; with Sem; use Sem; with Sem_Aux; use Sem_Aux; +with Sem_Ch5; use Sem_Ch5; with Sem_Ch6; use Sem_Ch6; with Sem_Ch8; use Sem_Ch8; with Sem_Ch9; use Sem_Ch9; @@ -3722,6 +3723,14 @@ package body Exp_Ch9 is Declarations => Decls, Handled_Statement_Sequence => Handled_Statement_Sequence (N))); + -- Analyze now and reset scopes for declarations so that Scope fields + -- currently denoting the entry will now denote the block scope. + + Analyze_Statements (Bod_Stmts); + + Reset_Scopes_To + (First (Bod_Stmts), Entity (Identifier (First (Bod_Stmts)))); + case Corresponding_Runtime_Package (Pid) is when System_Tasking_Protected_Objects_Entries => Append_To (Bod_Stmts, @@ -14977,7 +14986,27 @@ package body Exp_Ch9 is Next (Decl); end loop; + elsif Nkind (N) = N_Freeze_Entity then + + -- Scan the actions associated with a freeze node, which may + -- actually be declarations with entities that need to have + -- their scopes reset. + + Decl := First (Actions (N)); + while Present (Decl) loop + Reset_Scopes (Decl); + Next (Decl); + end loop; + elsif N /= Bod and then Nkind (N) in N_Proper_Body then + + -- A subprogram without a separate declaration may be encountered, + -- and we need to reset the subprogram's entity's scope. + + if Nkind (N) = N_Subprogram_Body then + Set_Scope (Defining_Entity (Specification (N)), E); + end if; + return Skip; end if; -- cgit v1.1 From 4cd30bf7e5bff7a5d7c78b442d3658f4a95fc31a Mon Sep 17 00:00:00 2001 From: Arnaud Charlet Date: Thu, 12 Dec 2019 10:02:42 +0000 Subject: [Ada] Define __gnat_personality_v0 for SEH 2019-12-12 Arnaud Charlet gcc/ada/ * raise-gcc.c (__gnat_personality_v0): Define for SEH. From-SVN: r279290 --- gcc/ada/ChangeLog | 4 ++++ gcc/ada/raise-gcc.c | 13 +++++++++++++ 2 files changed, 17 insertions(+) (limited to 'gcc/ada') diff --git a/gcc/ada/ChangeLog b/gcc/ada/ChangeLog index f28fa45..f911670 100644 --- a/gcc/ada/ChangeLog +++ b/gcc/ada/ChangeLog @@ -1,3 +1,7 @@ +2019-12-12 Arnaud Charlet + + * raise-gcc.c (__gnat_personality_v0): Define for SEH. + 2019-12-12 Gary Dismukes * exp_ch9.adb (Build_Protected_Entry): Analyze the block created diff --git a/gcc/ada/raise-gcc.c b/gcc/ada/raise-gcc.c index a77b731..1ba8af1 100644 --- a/gcc/ada/raise-gcc.c +++ b/gcc/ada/raise-gcc.c @@ -1599,6 +1599,19 @@ __gnat_personality_seh0 (PEXCEPTION_RECORD ms_exc, void *this_frame, __gnat_personality_imp); } +/* Define __gnat_personality_v0 for convenience */ + +PERSONALITY_STORAGE _Unwind_Reason_Code +__gnat_personality_v0 (version_arg_t version_arg, + phases_arg_t phases_arg, + _Unwind_Exception_Class uw_exception_class, + _Unwind_Exception *uw_exception, + _Unwind_Context *uw_context) +{ + return PERSONALITY_FUNCTION + (version_arg, phases_arg, uw_exception_class, uw_exception, uw_context); +} + #endif /* SEH */ #if !defined (__USING_SJLJ_EXCEPTIONS__) -- cgit v1.1 From c9312e3079094e6255f7b5603475f7cd1cb517aa Mon Sep 17 00:00:00 2001 From: Ed Schonberg Date: Thu, 12 Dec 2019 10:02:47 +0000 Subject: [Ada] Spurious visibility error on subunit with optimization 2019-12-12 Ed Schonberg gcc/ada/ * sem_ch10.adb (Analyze_Subunit): Fix spurious visibility error on subunit with optimization. From-SVN: r279291 --- gcc/ada/ChangeLog | 5 +++++ gcc/ada/sem_ch10.adb | 9 +++++++++ 2 files changed, 14 insertions(+) (limited to 'gcc/ada') diff --git a/gcc/ada/ChangeLog b/gcc/ada/ChangeLog index f911670..48448b2 100644 --- a/gcc/ada/ChangeLog +++ b/gcc/ada/ChangeLog @@ -1,3 +1,8 @@ +2019-12-12 Ed Schonberg + + * sem_ch10.adb (Analyze_Subunit): Fix spurious visibility error + on subunit with optimization. + 2019-12-12 Arnaud Charlet * raise-gcc.c (__gnat_personality_v0): Define for SEH. diff --git a/gcc/ada/sem_ch10.adb b/gcc/ada/sem_ch10.adb index c5d10f7..16f0807 100644 --- a/gcc/ada/sem_ch10.adb +++ b/gcc/ada/sem_ch10.adb @@ -2226,9 +2226,18 @@ package body Sem_Ch10 is -- If the subunit occurs within a child unit, we must restore the -- immediate visibility of any siblings that may occur in context. + -- In addition, we must reset the previous visibility of the + -- parent unit which is now on the scope stack. This is because + -- the Previous_Visibility was previously set when removing the + -- context. This is necessary to prevent the parent entity from + -- remaining visible after the subunit is compiled. This only + -- has an effect if a homonym exists in a body to be processed + -- later if inlining is enabled. if Present (Enclosing_Child) then Install_Siblings (Enclosing_Child, L); + Scope_Stack.Table (Scope_Stack.Last).Previous_Visibility := + False; end if; Push_Scope (Scop); -- cgit v1.1 From 16b5f07b5d210a7ae55576043855f50fa72f55db Mon Sep 17 00:00:00 2001 From: Steve Baird Date: Thu, 12 Dec 2019 10:02:51 +0000 Subject: [Ada] Implement AI12-0036 (a new legality check for instantiations) 2019-12-12 Steve Baird gcc/ada/ * sem_ch12.adb (Instantiate_Type.Validate_Derived_Type_Instance): Implement the legality check of AI12-0036 From-SVN: r279292 --- gcc/ada/ChangeLog | 6 ++++++ gcc/ada/sem_ch12.adb | 29 +++++++++++++++++++++++++++++ 2 files changed, 35 insertions(+) (limited to 'gcc/ada') diff --git a/gcc/ada/ChangeLog b/gcc/ada/ChangeLog index 48448b2..c2e4c36 100644 --- a/gcc/ada/ChangeLog +++ b/gcc/ada/ChangeLog @@ -1,3 +1,9 @@ +2019-12-12 Steve Baird + + * sem_ch12.adb + (Instantiate_Type.Validate_Derived_Type_Instance): Implement the + legality check of AI12-0036 + 2019-12-12 Ed Schonberg * sem_ch10.adb (Analyze_Subunit): Fix spurious visibility error diff --git a/gcc/ada/sem_ch12.adb b/gcc/ada/sem_ch12.adb index 8c3559f..e54e353 100644 --- a/gcc/ada/sem_ch12.adb +++ b/gcc/ada/sem_ch12.adb @@ -13166,6 +13166,35 @@ package body Sem_Ch12 is Abandon_Instantiation (Actual); end if; end if; + + -- Don't check Ada_Version here (for now) because AI12-0036 is + -- a binding interpretation; this decision may be reversed if + -- the situation turns out to be similar to that of the preceding + -- Is_Limited_Type test (see preceding comment). + + declare + Formal_Is_Private_Extension : constant Boolean := + Nkind (Parent (A_Gen_T)) = N_Private_Extension_Declaration; + + Actual_Is_Tagged : constant Boolean := Is_Tagged_Type (Act_T); + begin + if Actual_Is_Tagged /= Formal_Is_Private_Extension then + if In_Instance then + null; + else + if Actual_Is_Tagged then + Error_Msg_NE + ("actual for & cannot be a tagged type", + Actual, Gen_T); + else + Error_Msg_NE + ("actual for & must be a tagged type", + Actual, Gen_T); + end if; + Abandon_Instantiation (Actual); + end if; + end if; + end; end Validate_Derived_Type_Instance; ---------------------------------------- -- cgit v1.1 From 955379e4ed77883365cd041840bb17245810c095 Mon Sep 17 00:00:00 2001 From: Eric Botcazou Date: Thu, 12 Dec 2019 10:02:55 +0000 Subject: [Ada] Fix wrong value of 'Size for slices of bit-packed arrays (2) 2019-12-12 Eric Botcazou gcc/ada/ * exp_attr.adb (Expand_Size_Attribute): Look directly at the prefix to detect the bit-packed slices. Apply the checks last in case the attribute needs to be processed by the back-end. * exp_ch4.adb (Expand_N_Slice): Do not create a temporary for a prefix of the Size attribute. From-SVN: r279293 --- gcc/ada/ChangeLog | 8 ++++++++ gcc/ada/exp_attr.adb | 9 ++++----- gcc/ada/exp_ch4.adb | 6 ++++-- 3 files changed, 16 insertions(+), 7 deletions(-) (limited to 'gcc/ada') diff --git a/gcc/ada/ChangeLog b/gcc/ada/ChangeLog index c2e4c36..cf79c7d 100644 --- a/gcc/ada/ChangeLog +++ b/gcc/ada/ChangeLog @@ -1,3 +1,11 @@ +2019-12-12 Eric Botcazou + + * exp_attr.adb (Expand_Size_Attribute): Look directly at the + prefix to detect the bit-packed slices. Apply the checks last + in case the attribute needs to be processed by the back-end. + * exp_ch4.adb (Expand_N_Slice): Do not create a temporary for + a prefix of the Size attribute. + 2019-12-12 Steve Baird * sem_ch12.adb diff --git a/gcc/ada/exp_attr.adb b/gcc/ada/exp_attr.adb index 1459cfc..c7b6451 100644 --- a/gcc/ada/exp_attr.adb +++ b/gcc/ada/exp_attr.adb @@ -7455,8 +7455,6 @@ package body Exp_Attr is -- All other cases are handled by the back end else - Apply_Universal_Integer_Attribute_Checks (N); - -- If Size is applied to a formal parameter that is of a packed -- array subtype, then apply Size to the actual subtype. @@ -7489,9 +7487,7 @@ package body Exp_Attr is -- System.Unsigned_Types.Packed_Byte for code generation purposes so -- the size is always rounded up in the back end. - elsif Nkind (Original_Node (Pref)) = N_Slice - and then Is_Bit_Packed_Array (Ptyp) - then + elsif Nkind (Pref) = N_Slice and then Is_Bit_Packed_Array (Ptyp) then Rewrite (N, Make_Op_Multiply (Loc, Make_Attribute_Reference (Loc, @@ -7503,6 +7499,9 @@ package body Exp_Attr is Analyze_And_Resolve (N, Typ); end if; + -- Apply the required checks last, after rewriting has taken place + + Apply_Universal_Integer_Attribute_Checks (N); return; end if; diff --git a/gcc/ada/exp_ch4.adb b/gcc/ada/exp_ch4.adb index 158dcb5..20b3bab 100644 --- a/gcc/ada/exp_ch4.adb +++ b/gcc/ada/exp_ch4.adb @@ -11013,7 +11013,8 @@ package body Exp_Ch4 is -- 5. Prefix of an address attribute (this is an error which is caught -- elsewhere, and the expansion would interfere with generating the - -- error message). + -- error message) or of a size attribute (because 'Size may change + -- when applied to the temporary instead of the slice directly). if not Is_Packed (Typ) then @@ -11039,7 +11040,8 @@ package body Exp_Ch4 is return; elsif Nkind (Parent (N)) = N_Attribute_Reference - and then Attribute_Name (Parent (N)) = Name_Address + and then (Attribute_Name (Parent (N)) = Name_Address + or else Attribute_Name (Parent (N)) = Name_Size) then return; -- cgit v1.1 From 604801a4a689414e1dd264dced60b00d4e7517a5 Mon Sep 17 00:00:00 2001 From: Piotr Trojanek Date: Thu, 12 Dec 2019 10:03:01 +0000 Subject: [Ada] Fix repeated words and typos in doc and comments 2019-12-12 Piotr Trojanek gcc/ada/ * libgnat/g-altive.ads: Fix typo in comment. * bindo-graphs.adb: Fix repeated words in comment. * exp_ch4.adb: Likewise. * exp_ch5.adb: Likewise. * exp_ch7.adb: Likewise. * exp_pakd.adb: Likewise. * exp_unst.adb: Likewise. * exp_util.adb: Likewise. * freeze.adb: Likewise. * inline.adb: Likewise. * layout.adb: Likewise. * sem_ch12.adb: Likewise. * sem_ch13.adb: Likewise. * sem_ch4.adb: Likewise. * sem_ch9.adb: Likewise. * sem_elab.adb: Likewise. * doc/gnat_ugn/gnat_and_program_execution.rst: Fix repeated words in user documentation. * gnat_ugn.texi: Regenerate. From-SVN: r279294 --- gcc/ada/ChangeLog | 22 ++++++++++++++++++++++ gcc/ada/bindo-graphs.adb | 2 +- .../doc/gnat_ugn/gnat_and_program_execution.rst | 3 +-- gcc/ada/exp_ch4.adb | 6 +++--- gcc/ada/exp_ch5.adb | 4 ++-- gcc/ada/exp_ch7.adb | 2 +- gcc/ada/exp_pakd.adb | 2 +- gcc/ada/exp_unst.adb | 4 ++-- gcc/ada/exp_util.adb | 2 +- gcc/ada/freeze.adb | 2 +- gcc/ada/gnat_ugn.texi | 5 ++--- gcc/ada/inline.adb | 2 +- gcc/ada/layout.adb | 6 +++--- gcc/ada/libgnat/g-altive.ads | 2 +- gcc/ada/sem_ch12.adb | 6 +++--- gcc/ada/sem_ch13.adb | 10 +++++----- gcc/ada/sem_ch4.adb | 2 +- gcc/ada/sem_ch9.adb | 2 +- gcc/ada/sem_elab.adb | 16 ++++++++-------- 19 files changed, 60 insertions(+), 40 deletions(-) (limited to 'gcc/ada') diff --git a/gcc/ada/ChangeLog b/gcc/ada/ChangeLog index cf79c7d..09200b5 100644 --- a/gcc/ada/ChangeLog +++ b/gcc/ada/ChangeLog @@ -1,3 +1,25 @@ +2019-12-12 Piotr Trojanek + + * libgnat/g-altive.ads: Fix typo in comment. + * bindo-graphs.adb: Fix repeated words in comment. + * exp_ch4.adb: Likewise. + * exp_ch5.adb: Likewise. + * exp_ch7.adb: Likewise. + * exp_pakd.adb: Likewise. + * exp_unst.adb: Likewise. + * exp_util.adb: Likewise. + * freeze.adb: Likewise. + * inline.adb: Likewise. + * layout.adb: Likewise. + * sem_ch12.adb: Likewise. + * sem_ch13.adb: Likewise. + * sem_ch4.adb: Likewise. + * sem_ch9.adb: Likewise. + * sem_elab.adb: Likewise. + * doc/gnat_ugn/gnat_and_program_execution.rst: Fix repeated + words in user documentation. + * gnat_ugn.texi: Regenerate. + 2019-12-12 Eric Botcazou * exp_attr.adb (Expand_Size_Attribute): Look directly at the diff --git a/gcc/ada/bindo-graphs.adb b/gcc/ada/bindo-graphs.adb index e7585e2..7802e7d 100644 --- a/gcc/ada/bindo-graphs.adb +++ b/gcc/ada/bindo-graphs.adb @@ -1676,7 +1676,7 @@ package body Bindo.Graphs is -- successor and predecessor are kept consistent in both cases, and -- Add_Edge_With_Return will prevent the creation of the second edge. - -- Assume that that no Body_Before_Spec is necessary + -- Assume that no Body_Before_Spec is necessary Edge := No_Library_Graph_Edge; diff --git a/gcc/ada/doc/gnat_ugn/gnat_and_program_execution.rst b/gcc/ada/doc/gnat_ugn/gnat_and_program_execution.rst index cae61e9..0fb9bdd 100644 --- a/gcc/ada/doc/gnat_ugn/gnat_and_program_execution.rst +++ b/gcc/ada/doc/gnat_ugn/gnat_and_program_execution.rst @@ -1214,8 +1214,7 @@ for more information. Profiling ========= -This section describes how to use the the ``gprof`` profiler tool on Ada -programs. +This section describes how to use the ``gprof`` profiler tool on Ada programs. .. index:: ! gprof .. index:: Profiling diff --git a/gcc/ada/exp_ch4.adb b/gcc/ada/exp_ch4.adb index 20b3bab..bd45f70 100644 --- a/gcc/ada/exp_ch4.adb +++ b/gcc/ada/exp_ch4.adb @@ -11840,7 +11840,7 @@ package body Exp_Ch4 is -- The case where the target type is an anonymous access type of -- a discriminant is excluded, because the level of such a type -- depends on the context and currently the level returned for such - -- types is zero, resulting in warnings about about check failures + -- types is zero, resulting in warnings about check failures -- in certain legal cases involving class-wide interfaces as the -- designated type (some cases, such as return statements, are -- checked at run time, but not clear if these are handled right @@ -12320,8 +12320,8 @@ package body Exp_Ch4 is -- Remove the unchecked expression node from the tree. Its job was simply -- to make sure that its constituent expression was handled with checks - -- off, and now that that is done, we can remove it from the tree, and - -- indeed must, since Gigi does not expect to see these nodes. + -- off, and now that is done, we can remove it from the tree, and indeed + -- must, since Gigi does not expect to see these nodes. procedure Expand_N_Unchecked_Expression (N : Node_Id) is Exp : constant Node_Id := Expression (N); diff --git a/gcc/ada/exp_ch5.adb b/gcc/ada/exp_ch5.adb index f3139bd..b30171e 100644 --- a/gcc/ada/exp_ch5.adb +++ b/gcc/ada/exp_ch5.adb @@ -1065,8 +1065,8 @@ package body Exp_Ch5 is end if; -- Reset the Analyzed flag, because the bounds of the index - -- type itself may be universal, and must must be reanalyzed - -- to acquire the proper type for the back end. + -- type itself may be universal, and must be reanalyzed to + -- acquire the proper type for the back end. Set_Analyzed (Cleft_Lo, False); Set_Analyzed (Cright_Lo, False); diff --git a/gcc/ada/exp_ch7.adb b/gcc/ada/exp_ch7.adb index 297e27d..125eba6 100644 --- a/gcc/ada/exp_ch7.adb +++ b/gcc/ada/exp_ch7.adb @@ -376,7 +376,7 @@ package body Exp_Ch7 is procedure Check_Unnesting_In_Decls_Or_Stmts (Decls_Or_Stmts : List_Id); -- Similarly, the declarations or statements in library-level packages may - -- have created blocks blocks with nested subprograms. Such a block must be + -- have created blocks with nested subprograms. Such a block must be -- transformed into a procedure followed by a call to it, so that unnesting -- can handle uplevel references within these nested subprograms (typically -- subprograms that handle finalization actions). This also applies to diff --git a/gcc/ada/exp_pakd.adb b/gcc/ada/exp_pakd.adb index 2f45a72..7dcf241 100644 --- a/gcc/ada/exp_pakd.adb +++ b/gcc/ada/exp_pakd.adb @@ -1564,7 +1564,7 @@ package body Exp_Pakd is Silly_Boolean_Array_Xor_Test (N, R, Rtyp); end if; - -- Now that that silliness is taken care of, get packed array type + -- Now that silliness is taken care of, get packed array type Convert_To_PAT_Type (L); Convert_To_PAT_Type (R); diff --git a/gcc/ada/exp_unst.adb b/gcc/ada/exp_unst.adb index b25b449..6c1eb4b 100644 --- a/gcc/ada/exp_unst.adb +++ b/gcc/ada/exp_unst.adb @@ -526,8 +526,8 @@ package body Exp_Unst is procedure Note_Uplevel_Bound (N : Node_Id; Ref : Node_Id) is begin -- Entity name case. Make sure that the entity is declared - -- in a subprogram. This may not be the case for for a type - -- in a loop appearing in a precondition. + -- in a subprogram. This may not be the case for a type in a + -- loop appearing in a precondition. -- Exclude explicitly discriminants (that can appear -- in bounds of discriminated components). diff --git a/gcc/ada/exp_util.adb b/gcc/ada/exp_util.adb index 36c900b..7bd90e7 100644 --- a/gcc/ada/exp_util.adb +++ b/gcc/ada/exp_util.adb @@ -9718,7 +9718,7 @@ package body Exp_Util is end if; -- Do not generate a check within an internal subprogram (stream - -- functions and the like, including including predicate functions). + -- functions and the like, including predicate functions). if Within_Internal_Subprogram then return Make_Null_Statement (Loc); diff --git a/gcc/ada/freeze.adb b/gcc/ada/freeze.adb index 5e1b775..add4153 100644 --- a/gcc/ada/freeze.adb +++ b/gcc/ada/freeze.adb @@ -1502,7 +1502,7 @@ package body Freeze is -- In GNATprove mode this is where we can collect the inherited -- conditions, because we do not create the Check pragmas that - -- normally convey the the modified class-wide conditions on + -- normally convey the modified class-wide conditions on -- overriding operations. if GNATprove_Mode then diff --git a/gcc/ada/gnat_ugn.texi b/gcc/ada/gnat_ugn.texi index a1ef122..07db41f 100644 --- a/gcc/ada/gnat_ugn.texi +++ b/gcc/ada/gnat_ugn.texi @@ -21,7 +21,7 @@ @copying @quotation -GNAT User's Guide for Native Platforms , Oct 09, 2019 +GNAT User's Guide for Native Platforms , Dec 10, 2019 AdaCore @@ -20730,8 +20730,7 @@ for more information. @section Profiling -This section describes how to use the the @code{gprof} profiler tool on Ada -programs. +This section describes how to use the @code{gprof} profiler tool on Ada programs. @geindex gprof diff --git a/gcc/ada/inline.adb b/gcc/ada/inline.adb index 0d80ab2..c32c0c9 100644 --- a/gcc/ada/inline.adb +++ b/gcc/ada/inline.adb @@ -256,7 +256,7 @@ package body Inline is -- the call is in the main compilation unit, Caller is Empty. procedure Add_Inlined_Instance (E : Entity_Id); - -- Add instance E to the list of of inlined instances for the unit + -- Add instance E to the list of inlined instances for the unit procedure Add_Inlined_Subprogram (E : Entity_Id); -- Add subprogram E to the list of inlined subprograms for the unit diff --git a/gcc/ada/layout.adb b/gcc/ada/layout.adb index f8e9099..4fc502b 100644 --- a/gcc/ada/layout.adb +++ b/gcc/ada/layout.adb @@ -764,9 +764,9 @@ package body Layout is end if; -- Check components. If any component requires a higher alignment, - -- then we set that higher alignment in any case. Don't do this if - -- we have Optimize_Alignment set to Space. Note that that covers - -- the case of packed records, where we already set alignment to 1. + -- then we set that higher alignment in any case. Don't do this if we + -- have Optimize_Alignment set to Space. Note that covers the case of + -- packed records, where we already set alignment to 1. if not Optimize_Alignment_Space (E) then declare diff --git a/gcc/ada/libgnat/g-altive.ads b/gcc/ada/libgnat/g-altive.ads index 686ee85..a77a60d 100644 --- a/gcc/ada/libgnat/g-altive.ads +++ b/gcc/ada/libgnat/g-altive.ads @@ -494,7 +494,7 @@ end GNAT.Altivec; -- The central idea for the Ada bindings is to leverage on the existing GCC -- architecture, with the introduction of a Low_Level_Vectors abstraction. --- This abstaction acts as a representative of the vector-types and builtins +-- This abstraction acts as a representative of the vector-types and builtins -- compiler interface for either the Hard or the Soft case. -- For the Hard binding, Low_Level_Vectors exposes data types with a GCC diff --git a/gcc/ada/sem_ch12.adb b/gcc/ada/sem_ch12.adb index e54e353..6932368 100644 --- a/gcc/ada/sem_ch12.adb +++ b/gcc/ada/sem_ch12.adb @@ -4501,7 +4501,7 @@ package body Sem_Ch12 is -- the case of nested instances for the time being. -- When we generate a nested instance body, calling stubs for any - -- relevant subprogram will be be inserted immediately after the + -- relevant subprogram will be inserted immediately after the -- subprogram declarations, and will take precedence over the -- subsequent (original) body. (The stub and original body will be -- complete homographs, but this is permitted in an instance). @@ -5431,8 +5431,8 @@ package body Sem_Ch12 is Instantiating => True), Name => New_Occurrence_Of (Anon_Id, Loc)); - -- The generic may be a a child unit. The renaming needs an - -- identifier with the proper name. + -- The generic may be a child unit. The renaming needs an identifier + -- with the proper name. Set_Defining_Unit_Name (Specification (Unit_Renaming), Make_Defining_Identifier (Loc, Chars (Gen_Unit))); diff --git a/gcc/ada/sem_ch13.adb b/gcc/ada/sem_ch13.adb index 67ec0df..759b7ce 100644 --- a/gcc/ada/sem_ch13.adb +++ b/gcc/ada/sem_ch13.adb @@ -770,8 +770,8 @@ package body Sem_Ch13 is -- 1 .. 4 3 .. 6 1 3 -- 4 .. 7 0 .. 3 4 0 - -- The rule is that the first bit is is obtained by - -- subtracting the old ending bit from storage_unit - 1. + -- The rule is that the first bit is obtained by subtracting + -- the old ending bit from storage_unit - 1. Set_Component_Bit_Offset (Comp, (Storage_Unit_Offset * System_Storage_Unit) + @@ -13344,9 +13344,9 @@ package body Sem_Ch13 is => -- Build predicate function specification and preanalyze -- expression after type replacement. The function - -- declaration must be analyzed in the scope of the - -- type, but the the expression can reference components - -- and discriminants of the type. + -- declaration must be analyzed in the scope of the type, + -- but the expression can reference components and + -- discriminants of the type. if No (Predicate_Function (E)) then declare diff --git a/gcc/ada/sem_ch4.adb b/gcc/ada/sem_ch4.adb index 03c7440..58e178e 100644 --- a/gcc/ada/sem_ch4.adb +++ b/gcc/ada/sem_ch4.adb @@ -1555,7 +1555,7 @@ package body Sem_Ch4 is -- there is only a limited view of it and there is nothing in -- the context of the current unit that has required a regular -- compilation of the unit containing the type. We recognize - -- this unusual case by the fact that that unit is not analyzed. + -- this unusual case by the fact that unit is not analyzed. -- Note that the call being analyzed is in a different unit from -- the function declaration, and nothing indicates that the type -- is a limited view. diff --git a/gcc/ada/sem_ch9.adb b/gcc/ada/sem_ch9.adb index bc8ab36..82bf021 100644 --- a/gcc/ada/sem_ch9.adb +++ b/gcc/ada/sem_ch9.adb @@ -2758,7 +2758,7 @@ package body Sem_Ch9 is Insert_After (N, Obj_Decl); Mark_Rewrite_Insertion (Obj_Decl); - -- Relocate aspect Part_Of from the the original single protected + -- Relocate aspect Part_Of from the original single protected -- declaration to the anonymous object declaration. This emulates the -- placement of an equivalent source pragma. diff --git a/gcc/ada/sem_elab.adb b/gcc/ada/sem_elab.adb index 0c71f59..f3cac46 100644 --- a/gcc/ada/sem_elab.adb +++ b/gcc/ada/sem_elab.adb @@ -1457,7 +1457,7 @@ package body Sem_Elab is -- Types -- ----------- - -- The following type enumerates all possible Ghost mode mode kinds + -- The following type enumerates all possible Ghost mode kinds type Extended_Ghost_Mode is (Is_Ignored, @@ -4963,7 +4963,7 @@ package body Sem_Elab is Output_Active_Scenarios (Attr, New_In_State); end if; - -- Treat the attribute an an immediate invocation of the target when + -- Treat the attribute an immediate invocation of the target when -- switch -gnatd.o (conservative elaboration order for indirect -- calls) is in effect. This has the following desirable effects: -- @@ -10015,8 +10015,8 @@ package body Sem_Elab is function Find_Enclosing_Context (N : Node_Id) return Node_Id; pragma Inline (Find_Enclosing_Context); -- Return the nearest enclosing non-library-level or compilation unit - -- node which which encapsulates arbitrary node N. Return Empty is no - -- such context is available. + -- node which encapsulates arbitrary node N. Return Empty is no such + -- context is available. function In_Nested_Context (Outer : Node_Id; @@ -10916,8 +10916,8 @@ package body Sem_Elab is Spec_Id : Entity_Id; begin - -- The the task type has already been expanded, it carries the - -- procedure which emulates the behavior of the task body. + -- The task type has already been expanded, it carries the procedure + -- which emulates the behavior of the task body. if Present (Task_Body_Id) then Spec_Id := Task_Body_Id; @@ -10951,8 +10951,8 @@ package body Sem_Elab is Spec_Id : Entity_Id; begin - -- The the task type has already been expanded, it carries the - -- procedure which emulates the behavior of the task body. + -- The task type has already been expanded, it carries the procedure + -- which emulates the behavior of the task body. if Present (Task_Body_Id) then Spec_Id := Task_Body_Id; -- cgit v1.1 From ddb677163af059a8b16f53d9f6ebaf7af774f0e3 Mon Sep 17 00:00:00 2001 From: Piotr Trojanek Date: Thu, 12 Dec 2019 10:03:06 +0000 Subject: [Ada] Fix Global contract for the predefined Yield procedure 2019-12-12 Piotr Trojanek gcc/ada/ * libgnarl/a-dispat.ads (Yield): Update Global contract. From-SVN: r279295 --- gcc/ada/ChangeLog | 4 ++++ gcc/ada/libgnarl/a-dispat.ads | 4 +++- 2 files changed, 7 insertions(+), 1 deletion(-) (limited to 'gcc/ada') diff --git a/gcc/ada/ChangeLog b/gcc/ada/ChangeLog index 09200b5..52cb179 100644 --- a/gcc/ada/ChangeLog +++ b/gcc/ada/ChangeLog @@ -1,5 +1,9 @@ 2019-12-12 Piotr Trojanek + * libgnarl/a-dispat.ads (Yield): Update Global contract. + +2019-12-12 Piotr Trojanek + * libgnat/g-altive.ads: Fix typo in comment. * bindo-graphs.adb: Fix repeated words in comment. * exp_ch4.adb: Likewise. diff --git a/gcc/ada/libgnarl/a-dispat.ads b/gcc/ada/libgnarl/a-dispat.ads index b4e4d03..8e4dfe6 100644 --- a/gcc/ada/libgnarl/a-dispat.ads +++ b/gcc/ada/libgnarl/a-dispat.ads @@ -13,11 +13,13 @@ -- -- ------------------------------------------------------------------------------ +with Ada.Task_Identification; + package Ada.Dispatching is pragma Preelaborate (Dispatching); procedure Yield with - Global => null; + Global => (In_Out => Ada.Task_Identification.Tasking_State); Dispatching_Policy_Error : exception; end Ada.Dispatching; -- cgit v1.1 From 4bcf29692fd5ee57cc857157912e9ef492205075 Mon Sep 17 00:00:00 2001 From: Ed Schonberg Date: Thu, 12 Dec 2019 10:03:11 +0000 Subject: [Ada] Fix processing of standard predefined operators 2019-12-12 Ed Schonberg gcc/ada/ * sem_res.adb: Fix processing of standard predefined operators. From-SVN: r279296 --- gcc/ada/ChangeLog | 4 ++++ gcc/ada/sem_res.adb | 6 +++++- 2 files changed, 9 insertions(+), 1 deletion(-) (limited to 'gcc/ada') diff --git a/gcc/ada/ChangeLog b/gcc/ada/ChangeLog index 52cb179..49fdae7 100644 --- a/gcc/ada/ChangeLog +++ b/gcc/ada/ChangeLog @@ -1,3 +1,7 @@ +2019-12-12 Ed Schonberg + + * sem_res.adb: Fix processing of standard predefined operators. + 2019-12-12 Piotr Trojanek * libgnarl/a-dispat.ads (Yield): Update Global contract. diff --git a/gcc/ada/sem_res.adb b/gcc/ada/sem_res.adb index 4a50b09..560f0f0 100644 --- a/gcc/ada/sem_res.adb +++ b/gcc/ada/sem_res.adb @@ -8481,12 +8481,16 @@ package body Sem_Res is -- matches that of the formals. For a predefined operqtor, -- it is the scope that matters, given that the predefined -- equality has Any_Type formals. In either case the result - -- type (most often Booleam) must match the context . + -- type (most often Booleam) must match the context .The + -- scope is either that of the type if there is a generated + -- equality (when there is an equality for the component type) + -- or else Standard otherwise. while Present (It.Typ) loop if Etype (It.Nam) = Typ and then (Etype (First_Entity (It.Nam)) = Etype (L) + or else Scope (It.Nam) = Standard_Standard or else Scope (It.Nam) = Scope (T)) then Set_Entity (N, It.Nam); -- cgit v1.1 From 2f0a921fadf4e8bcc2820db0da227366ecd50bf7 Mon Sep 17 00:00:00 2001 From: Justin Squirek Date: Thu, 12 Dec 2019 10:03:16 +0000 Subject: [Ada] Broken privacy on Controlled type extensions 2019-12-12 Justin Squirek gcc/ada/ * sem_ch4.adb (Analyze_One_Call): Add condition to check for incorrectly resolved hidden controlled primitives. From-SVN: r279297 --- gcc/ada/ChangeLog | 5 +++++ gcc/ada/sem_ch4.adb | 54 +++++++++++++++++++++++++++++++++++++++++++++++++++-- 2 files changed, 57 insertions(+), 2 deletions(-) (limited to 'gcc/ada') diff --git a/gcc/ada/ChangeLog b/gcc/ada/ChangeLog index 49fdae7..7c77382 100644 --- a/gcc/ada/ChangeLog +++ b/gcc/ada/ChangeLog @@ -1,3 +1,8 @@ +2019-12-12 Justin Squirek + + * sem_ch4.adb (Analyze_One_Call): Add condition to check for + incorrectly resolved hidden controlled primitives. + 2019-12-12 Ed Schonberg * sem_res.adb: Fix processing of standard predefined operators. diff --git a/gcc/ada/sem_ch4.adb b/gcc/ada/sem_ch4.adb index 58e178e..81c5bfd 100644 --- a/gcc/ada/sem_ch4.adb +++ b/gcc/ada/sem_ch4.adb @@ -3249,6 +3249,7 @@ package body Sem_Ch4 is -- is already known to be compatible, and because this may be an -- indexing of a call with default parameters. + First_Form : Entity_Id; Formal : Entity_Id; Actual : Node_Id; Is_Indexed : Boolean := False; @@ -3581,8 +3582,9 @@ package body Sem_Ch4 is -- Normalize_Actuals has chained the named associations in the -- correct order of the formals. - Actual := First_Actual (N); - Formal := First_Formal (Nam); + Actual := First_Actual (N); + Formal := First_Formal (Nam); + First_Form := Formal; -- If we are analyzing a call rewritten from object notation, skip -- first actual, which may be rewritten later as an explicit @@ -3742,6 +3744,54 @@ package body Sem_Ch4 is end if; end loop; + -- Due to our current model of controlled type expansion we may + -- have resolved a user call to a non-visible controlled primitive + -- since these inherited subprograms may be generated in the current + -- scope. This is a side-effect of the need for the expander to be + -- able to resolve internally generated calls. + + -- Specifically, the issue appears when predefined controlled + -- operations get called on a type extension whose parent is a + -- private extension completed with a controlled extension - see + -- below: + + -- package X is + -- type Par_Typ is tagged private; + -- private + -- type Par_Typ is new Controlled with null record; + -- end; + -- ... + -- procedure Main is + -- type Ext_Typ is new Par_Typ with null record; + -- Obj : Ext_Typ; + -- begin + -- Finalize (Obj); -- Will improperly resolve + -- end; + + -- To avoid breaking privacy, Is_Hidden gets set elsewhere on such + -- primitives, but we still need to verify that Nam is indeed a + -- controlled subprogram. So, we do that here and issue the + -- appropriate error. + + if Is_Hidden (Nam) + and then not In_Instance + and then not Comes_From_Source (Nam) + and then Comes_From_Source (N) + + -- Verify Nam is a controlled primitive + + and then Nam_In (Chars (Nam), Name_Adjust, + Name_Finalize, + Name_Initialize) + and then Ekind (Nam) = E_Procedure + and then Is_Controlled (Etype (First_Form)) + and then No (Next_Formal (First_Form)) + then + Error_Msg_Node_2 := Etype (First_Form); + Error_Msg_NE ("call to non-visible controlled primitive & on type" + & " &", N, Nam); + end if; + -- On exit, all actuals match Indicate_Name_And_Type; -- cgit v1.1 From 4cdd4a33f42e0b3373bf74564d036a277dfc0dc1 Mon Sep 17 00:00:00 2001 From: Gary Dismukes Date: Thu, 12 Dec 2019 10:03:20 +0000 Subject: [Ada] Fix various typos, plus minor reformatting 2019-12-12 Gary Dismukes gcc/ada/ * sem_ch4.adb, sem_res.adb: Minor reformatting. From-SVN: r279298 --- gcc/ada/ChangeLog | 4 ++++ gcc/ada/sem_ch4.adb | 2 +- gcc/ada/sem_res.adb | 10 +++++----- 3 files changed, 10 insertions(+), 6 deletions(-) (limited to 'gcc/ada') diff --git a/gcc/ada/ChangeLog b/gcc/ada/ChangeLog index 7c77382..6396ee6 100644 --- a/gcc/ada/ChangeLog +++ b/gcc/ada/ChangeLog @@ -1,3 +1,7 @@ +2019-12-12 Gary Dismukes + + * sem_ch4.adb, sem_res.adb: Minor reformatting. + 2019-12-12 Justin Squirek * sem_ch4.adb (Analyze_One_Call): Add condition to check for diff --git a/gcc/ada/sem_ch4.adb b/gcc/ada/sem_ch4.adb index 81c5bfd..80be4d6 100644 --- a/gcc/ada/sem_ch4.adb +++ b/gcc/ada/sem_ch4.adb @@ -3747,7 +3747,7 @@ package body Sem_Ch4 is -- Due to our current model of controlled type expansion we may -- have resolved a user call to a non-visible controlled primitive -- since these inherited subprograms may be generated in the current - -- scope. This is a side-effect of the need for the expander to be + -- scope. This is a side effect of the need for the expander to be -- able to resolve internally generated calls. -- Specifically, the issue appears when predefined controlled diff --git a/gcc/ada/sem_res.adb b/gcc/ada/sem_res.adb index 560f0f0..22d89a3 100644 --- a/gcc/ada/sem_res.adb +++ b/gcc/ada/sem_res.adb @@ -8478,13 +8478,13 @@ package body Sem_Res is Get_First_Interp (N, I, It); -- If the equality is user-defined, the type of the operands - -- matches that of the formals. For a predefined operqtor, + -- matches that of the formals. For a predefined operator, -- it is the scope that matters, given that the predefined -- equality has Any_Type formals. In either case the result - -- type (most often Booleam) must match the context .The - -- scope is either that of the type if there is a generated - -- equality (when there is an equality for the component type) - -- or else Standard otherwise. + -- type (most often Boolean) must match the context. The scope + -- is either that of the type, if there is a generated equality + -- (when there is an equality for the component type), or else + -- Standard otherwise. while Present (It.Typ) loop if Etype (It.Nam) = Typ -- cgit v1.1 From fbb076f4dab3541351e4b5ffd5a79099873adae0 Mon Sep 17 00:00:00 2001 From: Steve Baird Date: Thu, 12 Dec 2019 10:03:26 +0000 Subject: [Ada] Improved handling of circular compilation dependencies 2019-12-12 Steve Baird gcc/ada/ * sem_ch10.adb (Install_With_Clause): Check for the case of a circular dependency involving a predefined (or GNAT-defined) unit and handle that case by generating an appropropriate error message. From-SVN: r279299 --- gcc/ada/ChangeLog | 7 +++++++ gcc/ada/sem_ch10.adb | 14 ++++++++++++++ 2 files changed, 21 insertions(+) (limited to 'gcc/ada') diff --git a/gcc/ada/ChangeLog b/gcc/ada/ChangeLog index 6396ee6..d14f7e3 100644 --- a/gcc/ada/ChangeLog +++ b/gcc/ada/ChangeLog @@ -1,3 +1,10 @@ +2019-12-12 Steve Baird + + * sem_ch10.adb (Install_With_Clause): Check for the case of a + circular dependency involving a predefined (or GNAT-defined) + unit and handle that case by generating an appropropriate error + message. + 2019-12-12 Gary Dismukes * sem_ch4.adb, sem_res.adb: Minor reformatting. diff --git a/gcc/ada/sem_ch10.adb b/gcc/ada/sem_ch10.adb index 16f0807..37518df 100644 --- a/gcc/ada/sem_ch10.adb +++ b/gcc/ada/sem_ch10.adb @@ -5336,6 +5336,20 @@ package body Sem_Ch10 is Error_Msg_N ("instantiation depends on itself", Name (With_Clause)); + elsif not Analyzed (Uname) + and then Is_Internal_Unit (Current_Sem_Unit) + and then not Is_Visible_Lib_Unit (Uname) + and then No (Scope (Uname)) + then + if Is_Predefined_Unit (Current_Sem_Unit) then + Error_Msg_N + ("predefined unit depends on itself", Name (With_Clause)); + else + Error_Msg_N + ("GNAT-defined unit depends on itself", Name (With_Clause)); + end if; + return; + elsif not Is_Visible_Lib_Unit (Uname) then -- Abandon processing in case of previous errors -- cgit v1.1 From ca00cd02323d71e99cebf583c34b07e7fc56c716 Mon Sep 17 00:00:00 2001 From: Gary Dismukes Date: Thu, 12 Dec 2019 10:03:30 +0000 Subject: [Ada] Fix related to handling up-level references in protected entries 2019-12-12 Gary Dismukes gcc/ada/ * exp_ch9.adb (Build_Protected_Entry): Set the Scope of the new block to be the entity of the procedure created for the entry. From-SVN: r279300 --- gcc/ada/ChangeLog | 5 +++++ gcc/ada/exp_ch9.adb | 5 ++++- 2 files changed, 9 insertions(+), 1 deletion(-) (limited to 'gcc/ada') diff --git a/gcc/ada/ChangeLog b/gcc/ada/ChangeLog index d14f7e3..386ae09 100644 --- a/gcc/ada/ChangeLog +++ b/gcc/ada/ChangeLog @@ -1,3 +1,8 @@ +2019-12-12 Gary Dismukes + + * exp_ch9.adb (Build_Protected_Entry): Set the Scope of the new + block to be the entity of the procedure created for the entry. + 2019-12-12 Steve Baird * sem_ch10.adb (Install_With_Clause): Check for the case of a diff --git a/gcc/ada/exp_ch9.adb b/gcc/ada/exp_ch9.adb index 6e34de1..60080e6 100644 --- a/gcc/ada/exp_ch9.adb +++ b/gcc/ada/exp_ch9.adb @@ -3724,10 +3724,13 @@ package body Exp_Ch9 is Handled_Statement_Sequence => Handled_Statement_Sequence (N))); -- Analyze now and reset scopes for declarations so that Scope fields - -- currently denoting the entry will now denote the block scope. + -- currently denoting the entry will now denote the block scope, and + -- the block's scope will be set to the new procedure entity. Analyze_Statements (Bod_Stmts); + Set_Scope (Entity (Identifier (First (Bod_Stmts))), Bod_Id); + Reset_Scopes_To (First (Bod_Stmts), Entity (Identifier (First (Bod_Stmts)))); -- cgit v1.1 From 0f5abd21483aeddbaa3dcd475ac0c686d835772e Mon Sep 17 00:00:00 2001 From: Ed Schonberg Date: Thu, 12 Dec 2019 10:03:35 +0000 Subject: [Ada] Improve error message for dispatching subprogram formals 2019-12-12 Ed Schonberg gcc/ada/ * sem_ch8.adb: Improve error message for dispatching subprogram formals. From-SVN: r279301 --- gcc/ada/ChangeLog | 5 +++++ gcc/ada/sem_ch8.adb | 11 ++++++++--- 2 files changed, 13 insertions(+), 3 deletions(-) (limited to 'gcc/ada') diff --git a/gcc/ada/ChangeLog b/gcc/ada/ChangeLog index 386ae09..d859109 100644 --- a/gcc/ada/ChangeLog +++ b/gcc/ada/ChangeLog @@ -1,3 +1,8 @@ +2019-12-12 Ed Schonberg + + * sem_ch8.adb: Improve error message for dispatching subprogram + formals. + 2019-12-12 Gary Dismukes * exp_ch9.adb (Build_Protected_Entry): Set the Scope of the new diff --git a/gcc/ada/sem_ch8.adb b/gcc/ada/sem_ch8.adb index 38cbf1c..8897b25 100644 --- a/gcc/ada/sem_ch8.adb +++ b/gcc/ada/sem_ch8.adb @@ -3453,9 +3453,14 @@ package body Sem_Ch8 is if Old_S_Ctrl_Type /= New_S_Ctrl_Type or else No (New_S_Ctrl_Type) then - Error_Msg_NE - ("actual must be dispatching subprogram for type&", - Nam, New_S_Ctrl_Type); + if No (New_S_Ctrl_Type) then + Error_Msg_N + ("actual must be dispatching subprogram", Nam); + else + Error_Msg_NE + ("actual must be dispatching subprogram for type&", + Nam, New_S_Ctrl_Type); + end if; else Set_Is_Dispatching_Operation (New_S); -- cgit v1.1 From 93350089be1a068328192eb1a89f232099d0f0c7 Mon Sep 17 00:00:00 2001 From: Ed Schonberg Date: Thu, 12 Dec 2019 10:03:39 +0000 Subject: [Ada] Missing dereference in bound of slice in element iterator 2019-12-12 Ed Schonberg gcc/ada/ * sem_ch5.adb: (Analyze_Iterator_Specification): If the iteration is over a slice, complete the resolution of its bounds, which may be aebitrary expressions. The previous pre-analysis may have created itypes for the slice but has not performed the expansion that for example may introduce actions that specify explicit dereferences and run-time checks. From-SVN: r279302 --- gcc/ada/ChangeLog | 9 +++++++++ gcc/ada/sem_ch5.adb | 21 +++++++++++++++++++++ 2 files changed, 30 insertions(+) (limited to 'gcc/ada') diff --git a/gcc/ada/ChangeLog b/gcc/ada/ChangeLog index d859109..11eca2c 100644 --- a/gcc/ada/ChangeLog +++ b/gcc/ada/ChangeLog @@ -1,5 +1,14 @@ 2019-12-12 Ed Schonberg + * sem_ch5.adb: (Analyze_Iterator_Specification): If the + iteration is over a slice, complete the resolution of its + bounds, which may be aebitrary expressions. The previous + pre-analysis may have created itypes for the slice but has not + performed the expansion that for example may introduce actions + that specify explicit dereferences and run-time checks. + +2019-12-12 Ed Schonberg + * sem_ch8.adb: Improve error message for dispatching subprogram formals. diff --git a/gcc/ada/sem_ch5.adb b/gcc/ada/sem_ch5.adb index 3abaa8d..a65e92c 100644 --- a/gcc/ada/sem_ch5.adb +++ b/gcc/ada/sem_ch5.adb @@ -2343,6 +2343,27 @@ package body Sem_Ch5 is Check_Reverse_Iteration (Typ); end if; + -- For an element iteration over a slice, we must complete + -- the resolution and expansion of the slice bounds. These + -- can be arbitrary expressions, and the preanalysis that + -- was performed in preparation for the iteration may have + -- generated an itype whose bounds must be fully expanded. + -- We set the parent node to provide a proper insertion + -- point for generated actions, if any. + + if Nkind (Iter_Name) = N_Slice + and then Nkind (Discrete_Range (Iter_Name)) = N_Range + and then not Analyzed (Discrete_Range (Iter_Name)) + then + declare + Indx : constant Node_Id := + Entity (First_Index (Etype (Iter_Name))); + begin + Set_Parent (Indx, Iter_Name); + Resolve (Scalar_Range (Indx), Etype (Indx)); + end; + end if; + -- The name in the renaming declaration may be a function call. -- Indicate that it does not come from source, to suppress -- spurious warnings on renamings of parameterless functions, -- cgit v1.1 From 97b2ffb81fdef1f0c2dc3ec337a9d9a61f3b98fc Mon Sep 17 00:00:00 2001 From: Steve Baird Date: Thu, 12 Dec 2019 10:03:43 +0000 Subject: [Ada] Tighten up semantic checking for protected subprogram declarations 2019-12-12 Steve Baird gcc/ada/ * sem_ch6.adb (New_Overloaded_Entity.Check_Conforming_Paramters): Add new Conformance_Type parameter. With the value of Subtype_Conformant, the behavior of Check_Conforming_Parameters is unchanged. The call in Matching_Entry_Or_Subprogram to instead passes in Type_Conformant. This corresponds to the use of "type conformant" in Ada RM 9.4(11.4/3). (New_Overloaded_Entity.Has_Matching_Entry_Or_Subprogram): Add new Normalized_First_Parameter_Type function to help in ignoring the distinction between protected and access-to-protected first parameters when checking prefixed-view profile matching. Replace computations of the type of the first parameter with calls to this function as appropriate. From-SVN: r279303 --- gcc/ada/ChangeLog | 16 +++++++++++++++ gcc/ada/sem_ch6.adb | 59 +++++++++++++++++++++++++++++++++++++++++------------ 2 files changed, 62 insertions(+), 13 deletions(-) (limited to 'gcc/ada') diff --git a/gcc/ada/ChangeLog b/gcc/ada/ChangeLog index 11eca2c..19e7fea 100644 --- a/gcc/ada/ChangeLog +++ b/gcc/ada/ChangeLog @@ -1,3 +1,19 @@ +2019-12-12 Steve Baird + + * sem_ch6.adb + (New_Overloaded_Entity.Check_Conforming_Paramters): Add new + Conformance_Type parameter. With the value of + Subtype_Conformant, the behavior of Check_Conforming_Parameters + is unchanged. The call in Matching_Entry_Or_Subprogram to + instead passes in Type_Conformant. This corresponds to the use + of "type conformant" in Ada RM 9.4(11.4/3). + (New_Overloaded_Entity.Has_Matching_Entry_Or_Subprogram): Add + new Normalized_First_Parameter_Type function to help in ignoring + the distinction between protected and access-to-protected first + parameters when checking prefixed-view profile matching. Replace + computations of the type of the first parameter with calls to + this function as appropriate. + 2019-12-12 Ed Schonberg * sem_ch5.adb: (Analyze_Iterator_Specification): If the diff --git a/gcc/ada/sem_ch6.adb b/gcc/ada/sem_ch6.adb index 5af3b7b..988edc6 100644 --- a/gcc/ada/sem_ch6.adb +++ b/gcc/ada/sem_ch6.adb @@ -10487,9 +10487,10 @@ package body Sem_Ch6 is is function Check_Conforming_Parameters (E1_Param : Node_Id; - E2_Param : Node_Id) return Boolean; + E2_Param : Node_Id; + Ctype : Conformance_Type) return Boolean; -- Starting from the given parameters, check that all the parameters - -- of two entries or subprograms are subtype conformant. Used to skip + -- of two entries or subprograms are conformant. Used to skip -- the check on the controlling argument. function Matching_Entry_Or_Subprogram @@ -10516,26 +10517,38 @@ package body Sem_Ch6 is -- whose name matches the original name of Subp and has a profile -- conformant with the profile of Subp; return Empty if not found. + function Normalized_First_Parameter_Type + (E : Entity_Id) return Entity_Id; + -- Return the type of the first parameter unless that type + -- is an anonymous access type, in which case return the + -- designated type. Used to treat anonymous-access-to-synchronized + -- the same as synchronized for purposes of checking for + -- prefixed view profile conflicts. + --------------------------------- -- Check_Conforming_Parameters -- --------------------------------- function Check_Conforming_Parameters (E1_Param : Node_Id; - E2_Param : Node_Id) return Boolean + E2_Param : Node_Id; + Ctype : Conformance_Type) return Boolean is Param_E1 : Node_Id := E1_Param; Param_E2 : Node_Id := E2_Param; begin while Present (Param_E1) and then Present (Param_E2) loop - if Ekind (Defining_Identifier (Param_E1)) /= - Ekind (Defining_Identifier (Param_E2)) - or else not + if (Ctype >= Mode_Conformant) and then + Ekind (Defining_Identifier (Param_E1)) /= + Ekind (Defining_Identifier (Param_E2)) + then + return False; + elsif not Conforming_Types (Find_Parameter_Type (Param_E1), Find_Parameter_Type (Param_E2), - Subtype_Conformant) + Ctype) then return False; end if; @@ -10568,7 +10581,8 @@ package body Sem_Ch6 is and then Check_Conforming_Parameters (First (Parameter_Specifications (Parent (E))), - Next (First (Parameter_Specifications (Parent (Subp))))) + Next (First (Parameter_Specifications (Parent (Subp)))), + Type_Conformant) then return E; end if; @@ -10608,7 +10622,8 @@ package body Sem_Ch6 is and then Check_Conforming_Parameters (First (Parameter_Specifications (Parent (Ent))), - Next (First (Parameter_Specifications (Parent (E))))) + Next (First (Parameter_Specifications (Parent (E)))), + Subtype_Conformant) then return E; end if; @@ -10662,6 +10677,21 @@ package body Sem_Ch6 is return Empty; end Matching_Original_Protected_Subprogram; + ------------------------------------- + -- Normalized_First_Parameter_Type -- + ------------------------------------- + + function Normalized_First_Parameter_Type + (E : Entity_Id) return Entity_Id + is + Result : Entity_Id := Etype (First_Entity (E)); + begin + if Ekind (Result) = E_Anonymous_Access_Type then + Result := Designated_Type (Result); + end if; + return Result; + end Normalized_First_Parameter_Type; + -- Start of processing for Has_Matching_Entry_Or_Subprogram begin @@ -10672,20 +10702,23 @@ package body Sem_Ch6 is if Comes_From_Source (E) and then Is_Subprogram (E) and then Present (First_Entity (E)) - and then Is_Concurrent_Record_Type (Etype (First_Entity (E))) + and then Is_Concurrent_Record_Type + (Normalized_First_Parameter_Type (E)) then if Scope (E) = Scope (Corresponding_Concurrent_Type - (Etype (First_Entity (E)))) + (Normalized_First_Parameter_Type (E))) and then Present (Matching_Entry_Or_Subprogram - (Corresponding_Concurrent_Type (Etype (First_Entity (E))), + (Corresponding_Concurrent_Type + (Normalized_First_Parameter_Type (E)), Subp => E)) then Report_Conflict (E, Matching_Entry_Or_Subprogram - (Corresponding_Concurrent_Type (Etype (First_Entity (E))), + (Corresponding_Concurrent_Type + (Normalized_First_Parameter_Type (E)), Subp => E)); return True; end if; -- cgit v1.1 From 4dd8320fbb787527b417ba7e69ae3786b511e813 Mon Sep 17 00:00:00 2001 From: Ed Schonberg Date: Thu, 12 Dec 2019 10:03:48 +0000 Subject: [Ada] Spurious error on universal access equality operator 2019-12-12 Ed Schonberg gcc/ada/ * sem_type.adb (Find_Unique_Type): A call to the universal access equality operator requires one operand to be a universal access, and the other to be an access type. There is no requirement, as previously implied by this routine, that pool-specific access types were illegal in this context. From-SVN: r279304 --- gcc/ada/ChangeLog | 8 ++++++++ gcc/ada/sem_type.adb | 4 ++-- 2 files changed, 10 insertions(+), 2 deletions(-) (limited to 'gcc/ada') diff --git a/gcc/ada/ChangeLog b/gcc/ada/ChangeLog index 19e7fea..f18df82 100644 --- a/gcc/ada/ChangeLog +++ b/gcc/ada/ChangeLog @@ -1,3 +1,11 @@ +2019-12-12 Ed Schonberg + + * sem_type.adb (Find_Unique_Type): A call to the universal + access equality operator requires one operand to be a universal + access, and the other to be an access type. There is no + requirement, as previously implied by this routine, that + pool-specific access types were illegal in this context. + 2019-12-12 Steve Baird * sem_ch6.adb diff --git a/gcc/ada/sem_type.adb b/gcc/ada/sem_type.adb index fc50524..e5d01dd 100644 --- a/gcc/ada/sem_type.adb +++ b/gcc/ada/sem_type.adb @@ -2286,12 +2286,13 @@ package body Sem_Type is -- ration "type P is access Integer" and an anonymous access to Integer, -- P is convertible to "access Integer" by 4.6 (24.11-24.15), but there -- is no rule in 4.6 that allows "access Integer" to be converted to P. + -- Note that this does not preclude one operand to be a pool-specific + -- access type, as a previous version of this code enforced. elsif Ada_Version >= Ada_2005 and then Ekind_In (Etype (L), E_Anonymous_Access_Type, E_Anonymous_Access_Subprogram_Type) and then Is_Access_Type (Etype (R)) - and then Ekind (Etype (R)) /= E_Access_Type then return Etype (L); @@ -2299,7 +2300,6 @@ package body Sem_Type is and then Ekind_In (Etype (R), E_Anonymous_Access_Type, E_Anonymous_Access_Subprogram_Type) and then Is_Access_Type (Etype (L)) - and then Ekind (Etype (L)) /= E_Access_Type then return Etype (R); -- cgit v1.1 From 8d9cf0a3b3e5629be6ff87f0db8232867555ece8 Mon Sep 17 00:00:00 2001 From: Ed Schonberg Date: Thu, 12 Dec 2019 10:03:53 +0000 Subject: [Ada] Spurious warning about change of representastion in call 2019-12-12 Ed Schonberg gcc/ada/ * sem_ch13.adb (Same_Reprewentation): if the actual in a call is a generic actual type, use its bsae type to determine whether a change of representastion may be necessary for proper parameter passing. From-SVN: r279305 --- gcc/ada/ChangeLog | 7 +++++++ gcc/ada/sem_ch13.adb | 8 ++++++++ 2 files changed, 15 insertions(+) (limited to 'gcc/ada') diff --git a/gcc/ada/ChangeLog b/gcc/ada/ChangeLog index f18df82..3423e2e 100644 --- a/gcc/ada/ChangeLog +++ b/gcc/ada/ChangeLog @@ -1,5 +1,12 @@ 2019-12-12 Ed Schonberg + * sem_ch13.adb (Same_Reprewentation): if the actual in a call is + a generic actual type, use its bsae type to determine whether a + change of representastion may be necessary for proper parameter + passing. + +2019-12-12 Ed Schonberg + * sem_type.adb (Find_Unique_Type): A call to the universal access equality operator requires one operand to be a universal access, and the other to be an access type. There is no diff --git a/gcc/ada/sem_ch13.adb b/gcc/ada/sem_ch13.adb index 759b7ce..b6d9705 100644 --- a/gcc/ada/sem_ch13.adb +++ b/gcc/ada/sem_ch13.adb @@ -13448,6 +13448,14 @@ package body Sem_Ch13 is and then Base_Type (T1) = Full_View (Base_Type (T2)) then return True; + + -- If T2 is a generic actual it is declared as a subtype, so + -- check against its base type. + + elsif Is_Generic_Actual_Type (T1) + and then Same_Representation (Base_Type (T1), T2) + then + return True; end if; -- Tagged types always have the same representation, because it is not -- cgit v1.1 From b622076c56b245967a8e777cfd8fd049e7ed784c Mon Sep 17 00:00:00 2001 From: Ed Schonberg Date: Fri, 13 Dec 2019 09:03:02 +0000 Subject: [Ada] New flag to indicate whether aspect appears on partial view 2019-12-13 Ed Schonberg gcc/ada/ * sinfo.ads, sinfo.adb (Aspect_On_Partial_View, Set_Aspect_On_Partial_View): New flag for use by SPARK, to indicate whether an aspect that appears on a type declaration applies to the partial view of that type. * sem_ch13.adb (Analyze_Aspect_Specification): Set new flag appropriately. From-SVN: r279339 --- gcc/ada/ChangeLog | 9 +++++++++ gcc/ada/sem_ch13.adb | 9 +++++++++ gcc/ada/sinfo.adb | 16 ++++++++++++++++ gcc/ada/sinfo.ads | 15 +++++++++++++++ 4 files changed, 49 insertions(+) (limited to 'gcc/ada') diff --git a/gcc/ada/ChangeLog b/gcc/ada/ChangeLog index 3423e2e..1c5d5bc 100644 --- a/gcc/ada/ChangeLog +++ b/gcc/ada/ChangeLog @@ -1,3 +1,12 @@ +2019-12-13 Ed Schonberg + + * sinfo.ads, sinfo.adb (Aspect_On_Partial_View, + Set_Aspect_On_Partial_View): New flag for use by SPARK, to + indicate whether an aspect that appears on a type declaration + applies to the partial view of that type. + * sem_ch13.adb (Analyze_Aspect_Specification): Set new flag + appropriately. + 2019-12-12 Ed Schonberg * sem_ch13.adb (Same_Reprewentation): if the actual in a call is diff --git a/gcc/ada/sem_ch13.adb b/gcc/ada/sem_ch13.adb index b6d9705..9c8a0cf 100644 --- a/gcc/ada/sem_ch13.adb +++ b/gcc/ada/sem_ch13.adb @@ -3788,6 +3788,15 @@ package body Sem_Ch13 is Set_From_Aspect_Specification (Aitem); end if; + -- For an aspect that applies to a type, indicate whether it + -- appears on a partial view of the type. + + if Is_Type (E) + and then Is_Private_Type (E) + then + Set_Aspect_On_Partial_View (Aspect); + end if; + -- In the context of a compilation unit, we directly put the -- pragma in the Pragmas_After list of the N_Compilation_Unit_Aux -- node (no delay is required here) except for aspects on a diff --git a/gcc/ada/sinfo.adb b/gcc/ada/sinfo.adb index 2689ebe..b99a32d 100644 --- a/gcc/ada/sinfo.adb +++ b/gcc/ada/sinfo.adb @@ -269,6 +269,14 @@ package body Sinfo is return Node3 (N); end Array_Aggregate; + function Aspect_On_Partial_View + (N : Node_Id) return Boolean is + begin + pragma Assert (False + or else NT (N).Nkind = N_Aspect_Specification); + return Flag18 (N); + end Aspect_On_Partial_View; + function Aspect_Rep_Item (N : Node_Id) return Node_Id is begin @@ -3763,6 +3771,14 @@ package body Sinfo is Set_Node3_With_Parent (N, Val); end Set_Array_Aggregate; + procedure Set_Aspect_On_Partial_View + (N : Node_Id; Val : Boolean := True) is + begin + pragma Assert (False + or else NT (N).Nkind = N_Aspect_Specification); + Set_Flag18 (N, Val); + end Set_Aspect_On_Partial_View; + procedure Set_Aspect_Rep_Item (N : Node_Id; Val : Node_Id) is begin diff --git a/gcc/ada/sinfo.ads b/gcc/ada/sinfo.ads index c64a76f..5e04772 100644 --- a/gcc/ada/sinfo.ads +++ b/gcc/ada/sinfo.ads @@ -933,6 +933,12 @@ package Sinfo is -- is used for translation of the at end handler into a normal exception -- handler. + -- Aspect_On_Partial_View (Flag18) + -- Present on an N_Aspect_Specification node. For an aspect that applies + -- to a type entity, indicates whether the specification appears on the + -- partial view of a private type or extension. Undefined for aspects + -- that apply to other entities. + -- Aspect_Rep_Item (Node2-Sem) -- Present in N_Aspect_Specification nodes. Points to the corresponding -- pragma/attribute definition node used to process the aspect. @@ -7638,6 +7644,7 @@ package Sinfo is -- Is_Disabled (Flag15-Sem) -- Is_Boolean_Aspect (Flag16-Sem) -- Split_PPC (Flag17) Set if split pre/post attribute + -- Aspect_On_Partial_View (Flag18-Sem) -- Note: Aspect_Specification is an Ada 2012 feature @@ -9299,6 +9306,9 @@ package Sinfo is function Array_Aggregate (N : Node_Id) return Node_Id; -- Node3 + function Aspect_On_Partial_View + (N : Node_Id) return Boolean; -- Flag18 + function Aspect_Rep_Item (N : Node_Id) return Node_Id; -- Node2 @@ -10411,6 +10421,9 @@ package Sinfo is procedure Set_Array_Aggregate (N : Node_Id; Val : Node_Id); -- Node3 + procedure Set_Aspect_On_Partial_View + (N : Node_Id; Val : Boolean := True); -- Flag18 + procedure Set_Aspect_Rep_Item (N : Node_Id; Val : Node_Id); -- Node2 @@ -13324,6 +13337,7 @@ package Sinfo is pragma Inline (Ancestor_Part); pragma Inline (Atomic_Sync_Required); pragma Inline (Array_Aggregate); + pragma Inline (Aspect_On_Partial_View); pragma Inline (Aspect_Rep_Item); pragma Inline (Assignment_OK); pragma Inline (Associated_Node); @@ -13690,6 +13704,7 @@ package Sinfo is pragma Inline (Set_Alternatives); pragma Inline (Set_Ancestor_Part); pragma Inline (Set_Array_Aggregate); + pragma Inline (Set_Aspect_On_Partial_View); pragma Inline (Set_Aspect_Rep_Item); pragma Inline (Set_Assignment_OK); pragma Inline (Set_Associated_Node); -- cgit v1.1 From 08f4f1721a05c77c8ee0cbd437c944d7c795f0d5 Mon Sep 17 00:00:00 2001 From: Justin Squirek Date: Fri, 13 Dec 2019 09:03:18 +0000 Subject: [Ada] Spurious error on overriding controlled primitive 2019-12-13 Justin Squirek gcc/ada/ * sem_ch6.adb (Check_Overriding_Indicator): Modify condition to take into account the modification of the Is_Hidden flag within generic instances. (Verify_Overriding_Indicator): Add an exception for controlled primitives within an instance. From-SVN: r279340 --- gcc/ada/ChangeLog | 8 ++++++++ gcc/ada/sem_ch6.adb | 29 +++++++++++++++++++++++------ 2 files changed, 31 insertions(+), 6 deletions(-) (limited to 'gcc/ada') diff --git a/gcc/ada/ChangeLog b/gcc/ada/ChangeLog index 1c5d5bc..1941a3d 100644 --- a/gcc/ada/ChangeLog +++ b/gcc/ada/ChangeLog @@ -1,3 +1,11 @@ +2019-12-13 Justin Squirek + + * sem_ch6.adb (Check_Overriding_Indicator): Modify condition to + take into account the modification of the Is_Hidden flag within + generic instances. + (Verify_Overriding_Indicator): Add an exception for controlled + primitives within an instance. + 2019-12-13 Ed Schonberg * sinfo.ads, sinfo.adb (Aspect_On_Partial_View, diff --git a/gcc/ada/sem_ch6.adb b/gcc/ada/sem_ch6.adb index 988edc6..386332c 100644 --- a/gcc/ada/sem_ch6.adb +++ b/gcc/ada/sem_ch6.adb @@ -3304,7 +3304,18 @@ package body Sem_Ch6 is then null; - elsif not Present (Overridden_Operation (Spec_Id)) then + -- Overridden controlled primitives may have had their + -- Overridden_Operation field cleared according to the setting of + -- the Is_Hidden flag. An issue arises, however, when analyzing + -- an instance that may have manipulated the flag during + -- expansion. As a result, we add an exception for this case. + + elsif not Present (Overridden_Operation (Spec_Id)) + and then not (Nam_In (Chars (Spec_Id), Name_Adjust, + Name_Finalize, + Name_Initialize) + and then In_Instance) + then Error_Msg_NE ("subprogram& is not overriding", Body_Spec, Spec_Id); @@ -6427,13 +6438,18 @@ package body Sem_Ch6 is -- If there is an overridden subprogram, then check that there is no -- "not overriding" indicator, and mark the subprogram as overriding. + -- This is not done if the overridden subprogram is marked as hidden, -- which can occur for the case of inherited controlled operations -- (see Derive_Subprogram), unless the inherited subprogram's parent - -- subprogram is not itself hidden. (Note: This condition could probably - -- be simplified, leaving out the testing for the specific controlled - -- cases, but it seems safer and clearer this way, and echoes similar - -- special-case tests of this kind in other places.) + -- subprogram is not itself hidden or we are within a generic instance, + -- in which case the hidden flag may have been modified for the + -- expansion of the instance. + + -- (Note: This condition could probably be simplified, leaving out the + -- testing for the specific controlled cases, but it seems safer and + -- clearer this way, and echoes similar special-case tests of this + -- kind in other places.) if Present (Overridden_Subp) and then (not Is_Hidden (Overridden_Subp) @@ -6442,7 +6458,8 @@ package body Sem_Ch6 is Name_Adjust, Name_Finalize) and then Present (Alias (Overridden_Subp)) - and then not Is_Hidden (Alias (Overridden_Subp)))) + and then (not Is_Hidden (Alias (Overridden_Subp)) + or else In_Instance))) then if Must_Not_Override (Spec) then Error_Msg_Sloc := Sloc (Overridden_Subp); -- cgit v1.1 From d7c37f454912c398302679e780ff69c76a3f843a Mon Sep 17 00:00:00 2001 From: Steve Baird Date: Fri, 13 Dec 2019 09:03:23 +0000 Subject: [Ada] Implement AI12-0101 2019-12-13 Steve Baird gcc/ada/ * exp_ch4.adb (Expand_N_Op_Eq.Is_Equality): Move this function from within Expand_N_Op_Eq.Find_Equality out to immediately within Expand_N_Op_Eq in order to give it greater visibility. Add a new Typ parameter (defaulted to Empty) which, if non-empty, means the function will return False in the case of an equality op for some other type. * (Expand_N_Op_Eq.User_Defined_Primitive_Equality_Op): A new function. Given an untagged record type, finds the corresponding user-defined primitive equality op (if any). May return Empty. Ignores visibility. * (Expand_N_Op): For Ada2012 or later, check for presence of a user-defined primitive equality op before falling back on the usual predefined component-by-component comparison. If found, then call the user-defined op instead. From-SVN: r279341 --- gcc/ada/ChangeLog | 17 +++++++ gcc/ada/exp_ch4.adb | 134 ++++++++++++++++++++++++++++++++++++++-------------- 2 files changed, 115 insertions(+), 36 deletions(-) (limited to 'gcc/ada') diff --git a/gcc/ada/ChangeLog b/gcc/ada/ChangeLog index 1941a3d..402933b 100644 --- a/gcc/ada/ChangeLog +++ b/gcc/ada/ChangeLog @@ -1,3 +1,20 @@ +2019-12-13 Steve Baird + + * exp_ch4.adb (Expand_N_Op_Eq.Is_Equality): Move this function + from within Expand_N_Op_Eq.Find_Equality out to immediately + within Expand_N_Op_Eq in order to give it greater visibility. + Add a new Typ parameter (defaulted to Empty) which, if + non-empty, means the function will return False in the case of + an equality op for some other type. + * (Expand_N_Op_Eq.User_Defined_Primitive_Equality_Op): A new + function. Given an untagged record type, finds the corresponding + user-defined primitive equality op (if any). May return Empty. + Ignores visibility. + * (Expand_N_Op): For Ada2012 or later, check for presence of a + user-defined primitive equality op before falling back on the + usual predefined component-by-component comparison. If found, + then call the user-defined op instead. + 2019-12-13 Justin Squirek * sem_ch6.adb (Check_Overriding_Indicator): Modify condition to diff --git a/gcc/ada/exp_ch4.adb b/gcc/ada/exp_ch4.adb index bd45f70..1955823 100644 --- a/gcc/ada/exp_ch4.adb +++ b/gcc/ada/exp_ch4.adb @@ -7520,10 +7520,21 @@ 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. @@ -7772,6 +7783,43 @@ 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 -- ------------------- @@ -7781,9 +7829,6 @@ package body Exp_Ch4 is -- Find an equality in a possible alias chain starting from primitive -- operation Prim. - function Is_Equality (Id : Entity_Id) return Boolean; - -- Determine whether arbitrary entity Id denotes an equality - --------------------------- -- Find_Aliased_Equality -- --------------------------- @@ -7807,39 +7852,6 @@ package body Exp_Ch4 is return Empty; end Find_Aliased_Equality; - ----------------- - -- Is_Equality -- - ----------------- - - function Is_Equality (Id : Entity_Id) 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 (Id) = E_Function - and then Chars (Id) = Name_Op_Eq - and then Base_Type (Etype (Id)) = Standard_Boolean - then - Formal_1 := First_Formal (Id); - 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 Etype (Formal_1) = Etype (Formal_2) - and then No (Next_Formal (Formal_2)); - end if; - - return False; - end Is_Equality; - -- Local variables Eq_Prim : Entity_Id; @@ -7869,6 +7881,47 @@ 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 Node_Id := Scope (Typ); + E : Entity_Id; + begin + -- Prune this search by somehow not looking at decls that precede + -- the declaration of the first view of Typ (which might be a partial + -- view)??? + + 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; + E := 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 -- ------------------------------------ @@ -8190,6 +8243,15 @@ 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. -- cgit v1.1 From 8daf00dd4a654c807618b01f92aac75e7842be13 Mon Sep 17 00:00:00 2001 From: Justin Squirek Date: Fri, 13 Dec 2019 09:03:28 +0000 Subject: [Ada] Missing accessibility checks on conditionals 2019-12-13 Justin Squirek gcc/ada/ * sem_res.adb (Resolve_Allocator): Add calls to Check_Cond_Expr_Accessibility when a conditional expression is found. (Check_Allocator_Discrim_Accessibility_Exprs): Created to recursively traverse a potentially compound conditional expression and perform accessibility checks for each alternative. * sem_util.adb (Dynamic_Accessibility_Level): Avoid use of original node of the expression in question so we can handle dynamic accessibility in the limited case of a constant folded conditional expression. From-SVN: r279342 --- gcc/ada/ChangeLog | 14 ++++++++++ gcc/ada/sem_res.adb | 72 +++++++++++++++++++++++++++++++++++++++++++++++++--- gcc/ada/sem_util.adb | 7 +++++ 3 files changed, 89 insertions(+), 4 deletions(-) (limited to 'gcc/ada') diff --git a/gcc/ada/ChangeLog b/gcc/ada/ChangeLog index 402933b..40c8bf32 100644 --- a/gcc/ada/ChangeLog +++ b/gcc/ada/ChangeLog @@ -1,3 +1,17 @@ +2019-12-13 Justin Squirek + + * sem_res.adb (Resolve_Allocator): Add calls to + Check_Cond_Expr_Accessibility when a conditional expression is + found. + (Check_Allocator_Discrim_Accessibility_Exprs): Created to + recursively traverse a potentially compound conditional + expression and perform accessibility checks for each + alternative. + * sem_util.adb (Dynamic_Accessibility_Level): Avoid use of + original node of the expression in question so we can handle + dynamic accessibility in the limited case of a constant folded + conditional expression. + 2019-12-13 Steve Baird * exp_ch4.adb (Expand_N_Op_Eq.Is_Equality): Move this function diff --git a/gcc/ada/sem_res.adb b/gcc/ada/sem_res.adb index 22d89a3..0bdbc25 100644 --- a/gcc/ada/sem_res.adb +++ b/gcc/ada/sem_res.adb @@ -4965,6 +4965,12 @@ package body Sem_Res is -- the cases of a constraint expression which is an access attribute or -- an access discriminant. + procedure Check_Allocator_Discrim_Accessibility_Exprs + (Curr_Exp : Node_Id; + Alloc_Typ : Entity_Id); + -- Dispatch checks performed by Check_Allocator_Discrim_Accessibility + -- across all expressions within a given conditional expression. + function In_Dispatching_Context return Boolean; -- If the allocator is an actual in a call, it is allowed to be class- -- wide when the context is not because it is a controlling actual. @@ -5016,6 +5022,62 @@ package body Sem_Res is end if; end Check_Allocator_Discrim_Accessibility; + ------------------------------------------------- + -- Check_Allocator_Discrim_Accessibility_Exprs -- + ------------------------------------------------- + + procedure Check_Allocator_Discrim_Accessibility_Exprs + (Curr_Exp : Node_Id; + Alloc_Typ : Entity_Id) + is + Alt : Node_Id; + Expr : Node_Id; + Disc_Exp : constant Node_Id := Original_Node (Curr_Exp); + begin + -- When conditional expressions are constant folded we know at + -- compile time which expression to check - so don't bother with + -- the rest of the cases. + + if Nkind (Curr_Exp) = N_Attribute_Reference then + Check_Allocator_Discrim_Accessibility (Curr_Exp, Alloc_Typ); + + -- Non-constant-folded if expressions + + elsif Nkind (Disc_Exp) = N_If_Expression then + -- Check both expressions if they are still present in the face + -- of expansion. + + Expr := Next (First (Expressions (Disc_Exp))); + if Present (Expr) then + Check_Allocator_Discrim_Accessibility_Exprs (Expr, Alloc_Typ); + Expr := Next (Expr); + if Present (Expr) then + Check_Allocator_Discrim_Accessibility_Exprs + (Expr, Alloc_Typ); + end if; + end if; + + -- Non-constant-folded case expressions + + elsif Nkind (Disc_Exp) = N_Case_Expression then + -- Check all alternatives + + Alt := First (Alternatives (Disc_Exp)); + while Present (Alt) loop + Check_Allocator_Discrim_Accessibility_Exprs + (Expression (Alt), Alloc_Typ); + + Next (Alt); + end loop; + + -- Base case, check the accessibility of the original node of the + -- expression. + + else + Check_Allocator_Discrim_Accessibility (Disc_Exp, Alloc_Typ); + end if; + end Check_Allocator_Discrim_Accessibility_Exprs; + ---------------------------- -- In_Dispatching_Context -- ---------------------------- @@ -5167,7 +5229,8 @@ package body Sem_Res is while Present (Discrim) and then Present (Disc_Exp) loop if Ekind (Etype (Discrim)) = E_Anonymous_Access_Type then - Check_Allocator_Discrim_Accessibility (Disc_Exp, Typ); + Check_Allocator_Discrim_Accessibility_Exprs + (Disc_Exp, Typ); end if; Next_Discriminant (Discrim); @@ -5225,12 +5288,13 @@ package body Sem_Res is while Present (Discrim) and then Present (Constr) loop if Ekind (Etype (Discrim)) = E_Anonymous_Access_Type then if Nkind (Constr) = N_Discriminant_Association then - Disc_Exp := Original_Node (Expression (Constr)); + Disc_Exp := Expression (Constr); else - Disc_Exp := Original_Node (Constr); + Disc_Exp := Constr; end if; - Check_Allocator_Discrim_Accessibility (Disc_Exp, Typ); + Check_Allocator_Discrim_Accessibility_Exprs + (Disc_Exp, Typ); end if; Next_Discriminant (Discrim); diff --git a/gcc/ada/sem_util.adb b/gcc/ada/sem_util.adb index 22ecf21..91137ad 100644 --- a/gcc/ada/sem_util.adb +++ b/gcc/ada/sem_util.adb @@ -6612,6 +6612,13 @@ package body Sem_Util is end if; end if; + -- Handle a constant-folded conditional expression by avoiding use of + -- the original node. + + if Nkind_In (Expr, N_Case_Expression, N_If_Expression) then + Expr := N; + end if; + -- Unimplemented: Ptr.all'Access, where Ptr has Extra_Accessibility ??? case Nkind (Expr) is -- cgit v1.1 From 9ea2a24d506d0d45231ac9c783336a8309b6dd20 Mon Sep 17 00:00:00 2001 From: Arnaud Charlet Date: Fri, 13 Dec 2019 09:03:34 +0000 Subject: [Ada] Add Ada.Containers.Vectors.Generic_Parallel_Sorting to known units 2019-12-13 Arnaud Charlet gcc/ada/ * impunit.adb (Non_Imp_File_Names_12): Add Ada.Containers.Vectors.Generic_Parallel_Sorting. From-SVN: r279343 --- gcc/ada/ChangeLog | 5 +++++ gcc/ada/impunit.adb | 4 +++- 2 files changed, 8 insertions(+), 1 deletion(-) (limited to 'gcc/ada') diff --git a/gcc/ada/ChangeLog b/gcc/ada/ChangeLog index 40c8bf32..aabc2d4 100644 --- a/gcc/ada/ChangeLog +++ b/gcc/ada/ChangeLog @@ -1,3 +1,8 @@ +2019-12-13 Arnaud Charlet + + * impunit.adb (Non_Imp_File_Names_12): Add + Ada.Containers.Vectors.Generic_Parallel_Sorting. + 2019-12-13 Justin Squirek * sem_res.adb (Resolve_Allocator): Add calls to diff --git a/gcc/ada/impunit.adb b/gcc/ada/impunit.adb index 7048ab4..11d3a90 100644 --- a/gcc/ada/impunit.adb +++ b/gcc/ada/impunit.adb @@ -609,7 +609,9 @@ package body Impunit is ("a-cforse", F), -- Ada.Containers.Formal_Ordered_Sets ("a-cforma", F), -- Ada.Containers.Formal_Ordered_Maps ("a-cfhase", F), -- Ada.Containers.Formal_Hashed_Sets - ("a-cfhama", F)); -- Ada.Containers.Formal_Hashed_Maps + ("a-cfhama", F), -- Ada.Containers.Formal_Hashed_Maps + ("a-cvgpso", F) -- Ada.Containers.Vectors.Generic_Parallel_Sorting from + ); -- GNATCOLL.OMP ----------------------- -- Alternative Units -- -- cgit v1.1 From 563be3ee1db9e0fb1f37e13b02cff6651e934bee Mon Sep 17 00:00:00 2001 From: Gary Dismukes Date: Fri, 13 Dec 2019 09:03:40 +0000 Subject: [Ada] Up-level addressing problems with private tasks and selective accept procs 2019-12-13 Gary Dismukes gcc/ada/ * sem_util.adb (Scope_Within): For the case of checking for a task type procedure, check the Implementation_Base_Type of Curr. (Scope_Within_Or_Same): For the case of checking for a task type procedure, check the Implementation_Base_Type of Curr. From-SVN: r279344 --- gcc/ada/ChangeLog | 7 +++++++ gcc/ada/sem_util.adb | 10 ++++++---- 2 files changed, 13 insertions(+), 4 deletions(-) (limited to 'gcc/ada') diff --git a/gcc/ada/ChangeLog b/gcc/ada/ChangeLog index aabc2d4..4cd789f 100644 --- a/gcc/ada/ChangeLog +++ b/gcc/ada/ChangeLog @@ -1,3 +1,10 @@ +2019-12-13 Gary Dismukes + + * sem_util.adb (Scope_Within): For the case of checking for a + task type procedure, check the Implementation_Base_Type of Curr. + (Scope_Within_Or_Same): For the case of checking for a task type + procedure, check the Implementation_Base_Type of Curr. + 2019-12-13 Arnaud Charlet * impunit.adb (Non_Imp_File_Names_12): Add diff --git a/gcc/ada/sem_util.adb b/gcc/ada/sem_util.adb index 91137ad..ea87a3a 100644 --- a/gcc/ada/sem_util.adb +++ b/gcc/ada/sem_util.adb @@ -24721,8 +24721,9 @@ package body Sem_Util is -- A selective accept body appears within a task type, but the -- enclosing subprogram is the procedure of the task body. - elsif Ekind (Curr) = E_Task_Type - and then Outer = Task_Body_Procedure (Curr) + elsif Ekind (Implementation_Base_Type (Curr)) = E_Task_Type + and then + Outer = Task_Body_Procedure (Implementation_Base_Type (Curr)) then return True; @@ -24763,8 +24764,9 @@ package body Sem_Util is if Curr = Outer then return True; - elsif Ekind (Curr) = E_Task_Type - and then Outer = Task_Body_Procedure (Curr) + elsif Ekind (Implementation_Base_Type (Curr)) = E_Task_Type + and then + Outer = Task_Body_Procedure (Implementation_Base_Type (Curr)) then return True; -- cgit v1.1 From 90366d65738e17da9998dc5618d6e970b6ee3b48 Mon Sep 17 00:00:00 2001 From: Bob Duff Date: Fri, 13 Dec 2019 09:03:45 +0000 Subject: [Ada] Rtsfind: minor comment fixes 2019-12-13 Bob Duff gcc/ada/ * rtsfind.ads: Minor comment fix. From-SVN: r279345 --- gcc/ada/ChangeLog | 4 +++ gcc/ada/rtsfind.ads | 71 +++++++++-------------------------------------------- 2 files changed, 15 insertions(+), 60 deletions(-) (limited to 'gcc/ada') diff --git a/gcc/ada/ChangeLog b/gcc/ada/ChangeLog index 4cd789f..5f2b502 100644 --- a/gcc/ada/ChangeLog +++ b/gcc/ada/ChangeLog @@ -1,3 +1,7 @@ +2019-12-13 Bob Duff + + * rtsfind.ads: Minor comment fix. + 2019-12-13 Gary Dismukes * sem_util.adb (Scope_Within): For the case of checking for a diff --git a/gcc/ada/rtsfind.ads b/gcc/ada/rtsfind.ads index 2467f85..07b8069 100644 --- a/gcc/ada/rtsfind.ads +++ b/gcc/ada/rtsfind.ads @@ -36,59 +36,10 @@ package Rtsfind is -- Runtime Unit Table -- ------------------------ - -- The following type includes an enumeration entry for each runtime unit. - -- The enumeration literal represents the fully qualified name of the unit, - -- as follows: - - -- Names of the form Ada_xxx are first level children of Ada, whose name - -- is Ada.xxx. For example, the name Ada_Tags refers to package Ada.Tags. - - -- Names of the form Ada_Calendar_xxx are second level children of - -- Ada.Calendar. This is part of a temporary implementation of delays; - -- eventually, packages implementing delays will be found relative to - -- the package that declares the time type. - - -- Names of the form Ada_Interrupts_xxx are second level children of - -- Ada.Interrupts. This is needed for Ada.Interrupts.Names which is used - -- by pragma Interrupt_State. - - -- Names of the form Ada_Real_Time_xxx are second level children of - -- Ada.Real_Time. - - -- Names of the form Ada_Streams_xxx are second level children - -- of Ada.Streams. - - -- Names of the form Ada_Strings_xxx are second level children - -- of Ada.Strings. - - -- Names of the form Ada_Text_IO_xxx are second level children of - -- Ada.Text_IO. - - -- Names of the form Ada_Wide_Text_IO_xxx are second level children of - -- Ada.Wide_Text_IO. - - -- Names of the form Ada_Wide_Wide_Text_IO_xxx are second level children - -- of Ada.Wide_Wide_Text_IO. - - -- Names of the form Interfaces_xxx are first level children of - -- Interfaces. For example, the name Interfaces_Packed_Decimal refers to - -- package Interfaces.Packed_Decimal. - - -- Names of the form System_xxx are first level children of System, whose - -- name is System.xxx. For example, the name System_Str_Concat refers to - -- package System.Str_Concat. - - -- Names of the form System_Storage_Pools_xxx are second level children - -- of the package System.Storage_Pools. - - -- Names of the form System_Strings_xxx are second level children of the - -- package System.Strings. - - -- Names of the form System_Tasking_xxx are second level children of the - -- package System.Tasking. For example, System_Tasking_Stages refers to - -- the package System.Tasking.Stages. - - -- Other names stand for themselves (e.g. System for package System) + -- The following type includes an enumeration literal for each runtime + -- unit. The enumeration literal is the full expanded name of the unit + -- with "." replaced by "_". For example, the enumeration literal for + -- Ada.Interrupts.Names is Ada_Interrupts_Names -- This list can contain both subprogram and package unit names. For -- packages, the accessible entities in the package are separately listed @@ -100,13 +51,13 @@ package Rtsfind is -- seem worthwhile, since the implementation controls the set of units that -- are referenced, and this restriction is easily met. - -- IMPORTANT NOTE: the specs of packages and procedures with'ed using this - -- mechanism may not contain use clauses. This is because these subprograms - -- are compiled in the current visibility environment, and it would be too - -- much trouble to establish a clean environment for the compilation. The - -- presence of extraneous visible stuff has no effect on the compilation - -- except in the presence of use clauses (which might result in unexpected - -- ambiguities). + -- IMPORTANT NOTE: the specs of packages and procedures with'ed using + -- this mechanism must not contain use clauses. This is because these + -- subprograms are compiled in the current visibility environment, and it + -- would be too much trouble to establish a clean environment for the + -- compilation. The presence of extraneous visible stuff has no effect on + -- the compilation except in the presence of use clauses, which might + -- result in unexpected ambiguities. type RTU_Id is ( -- cgit v1.1 From e841d4d8b3d1e64fe2f31329c8644ceca341874f Mon Sep 17 00:00:00 2001 From: Bob Duff Date: Fri, 13 Dec 2019 09:03:50 +0000 Subject: [Ada] Ada2020: Update Impunit for Ada 202X 2019-12-13 Bob Duff gcc/ada/ * impunit.ads: Add Ada_202X_Unit. * impunit.adb: Add a table Non_Imp_File_Names_2X analogous to the other tables. Add code to search this table. * opt.ads: Add Warn_On_Ada_202X_Compatibility flag, currently always True. * sem_ch10.adb (Analyze_With_Clause): Give a warning if an Ada 2020 unit is with-ed when Ada_Version < Ada_2020. Change 'if' to 'case': Full coverage rules rule. From-SVN: r279346 --- gcc/ada/ChangeLog | 11 +++++++++++ gcc/ada/impunit.adb | 21 +++++++++++++++++++++ gcc/ada/impunit.ads | 18 ++++++------------ gcc/ada/opt.ads | 6 ++++++ gcc/ada/sem_ch10.adb | 43 +++++++++++++++++++++++++------------------ 5 files changed, 69 insertions(+), 30 deletions(-) (limited to 'gcc/ada') diff --git a/gcc/ada/ChangeLog b/gcc/ada/ChangeLog index 5f2b502..209a2d4 100644 --- a/gcc/ada/ChangeLog +++ b/gcc/ada/ChangeLog @@ -1,5 +1,16 @@ 2019-12-13 Bob Duff + * impunit.ads: Add Ada_202X_Unit. + * impunit.adb: Add a table Non_Imp_File_Names_2X analogous to + the other tables. Add code to search this table. + * opt.ads: Add Warn_On_Ada_202X_Compatibility flag, currently + always True. + * sem_ch10.adb (Analyze_With_Clause): Give a warning if an Ada + 2020 unit is with-ed when Ada_Version < Ada_2020. Change 'if' + to 'case': Full coverage rules rule. + +2019-12-13 Bob Duff + * rtsfind.ads: Minor comment fix. 2019-12-13 Gary Dismukes diff --git a/gcc/ada/impunit.adb b/gcc/ada/impunit.adb index 11d3a90..6bff383 100644 --- a/gcc/ada/impunit.adb +++ b/gcc/ada/impunit.adb @@ -613,6 +613,19 @@ package body Impunit is ("a-cvgpso", F) -- Ada.Containers.Vectors.Generic_Parallel_Sorting from ); -- GNATCOLL.OMP + -------------------- + -- Ada 202X Units -- + -------------------- + + -- The following units should be used only in Ada 202X mode + + Non_Imp_File_Names_2X : constant File_List := ( + 0 => ("a-stteou", T) -- Ada.Strings.Text_Output + -- ???We use named notation, because there is only one of these so far. + -- When we add more, we should switch to positional notation, and erase + -- the "0 =>". + ); + ----------------------- -- Alternative Units -- ----------------------- @@ -733,6 +746,14 @@ package body Impunit is end if; end loop; + -- See if name is in 202X list + + for J in Non_Imp_File_Names_2X'Range loop + if Buffer = Non_Imp_File_Names_2X (J).Fname then + return Ada_202X_Unit; + end if; + end loop; + -- Only remaining special possibilities are children of System.RPC and -- System.Garlic and special files of the form System.Aux... diff --git a/gcc/ada/impunit.ads b/gcc/ada/impunit.ads index 466cb86..7e6ea61 100644 --- a/gcc/ada/impunit.ads +++ b/gcc/ada/impunit.ads @@ -45,19 +45,13 @@ package Impunit is -- This is not a predefined unit, so no checks are needed Ada_95_Unit, - -- This unit is defined in the Ada 95 RM, and can be freely with'ed in - -- both Ada 95 mode and Ada 05 mode. Note that in Ada 83 mode, no child - -- units are allowed, so you can't even name such a unit. - Ada_2005_Unit, - -- This unit is defined in the Ada 2005 RM. Withing this unit from an - -- Ada 95 mode program will generate a warning (again, strictly speaking - -- this should be an error, but that seems over-strenuous). - - Ada_2012_Unit); - -- This unit is defined in the Ada 2012 RM. Withing this unit from an - -- Ada 95 or 2005 mode program will generate a warning (again, strictly - -- speaking this should be an error, but that seems over-strenuous). + Ada_2012_Unit, + Ada_202X_Unit); + -- This unit is defined in the Ada RM of the given year. This is used to + -- give a warning when withing a unit from a wrong mode (e.g. withing an + -- Ada_2012_Unit when compiling with -gnat95). Note that in Ada 83 mode, + -- no child units are allowed, so you can't even name such a unit. function Get_Kind_Of_Unit (U : Unit_Number_Type) return Kind_Of_Unit; -- Given the unit number of a unit, this function determines the type diff --git a/gcc/ada/opt.ads b/gcc/ada/opt.ads index 9453464..fcfafc4 100644 --- a/gcc/ada/opt.ads +++ b/gcc/ada/opt.ads @@ -1767,6 +1767,12 @@ package Opt is -- including warnings on Ada 2012 obsolescent features used in Ada 2012 -- mode. Modified by use of -gnatwy/Y. + Warn_On_Ada_202X_Compatibility : Boolean := True; + -- GNAT + -- Set to True to generate all warnings on Ada 202X compatibility issues, + -- including warnings on Ada 202X obsolescent features used in Ada 202X + -- mode. ???There is no warning switch for this yet. + Warn_On_All_Unread_Out_Parameters : Boolean := False; -- GNAT -- Set to True to generate warnings in all cases where a variable is diff --git a/gcc/ada/sem_ch10.adb b/gcc/ada/sem_ch10.adb index 37518df..ae8bca7 100644 --- a/gcc/ada/sem_ch10.adb +++ b/gcc/ada/sem_ch10.adb @@ -2666,12 +2666,8 @@ package body Sem_Ch10 is and then not Implicit_With (N) and then not Restriction_Violation then - declare - U_Kind : constant Kind_Of_Unit := - Get_Kind_Of_Unit (Get_Source_Unit (U)); - - begin - if U_Kind = Implementation_Unit then + case Get_Kind_Of_Unit (Get_Source_Unit (U)) is + when Implementation_Unit => Error_Msg_F ("& is an internal 'G'N'A'T unit?i?", Name (N)); -- Add alternative name if available, otherwise issue a @@ -2685,19 +2681,30 @@ package body Sem_Ch10 is & "version-dependent?i?", Name (N)); end if; - elsif U_Kind = Ada_2005_Unit - and then Ada_Version < Ada_2005 - and then Warn_On_Ada_2005_Compatibility - then - Error_Msg_N ("& is an Ada 2005 unit?i?", Name (N)); + when Not_Predefined_Unit | Ada_95_Unit => + null; -- no checks needed - elsif U_Kind = Ada_2012_Unit - and then Ada_Version < Ada_2012 - and then Warn_On_Ada_2012_Compatibility - then - Error_Msg_N ("& is an Ada 2012 unit?i?", Name (N)); - end if; - end; + when Ada_2005_Unit => + if Ada_Version < Ada_2005 + and then Warn_On_Ada_2005_Compatibility + then + Error_Msg_N ("& is an Ada 2005 unit?i?", Name (N)); + end if; + + when Ada_2012_Unit => + if Ada_Version < Ada_2012 + and then Warn_On_Ada_2012_Compatibility + then + Error_Msg_N ("& is an Ada 2012 unit?i?", Name (N)); + end if; + + when Ada_202X_Unit => + if Ada_Version < Ada_2020 + and then Warn_On_Ada_202X_Compatibility + then + Error_Msg_N ("& is an Ada 202X unit?i?", Name (N)); + end if; + end case; end if; end if; -- cgit v1.1 From 2e3795d016a7263c82a4f64a7204f416d12a72da Mon Sep 17 00:00:00 2001 From: Yannick Moy Date: Fri, 13 Dec 2019 09:03:56 +0000 Subject: [Ada] Prevent inlining inside condition of while loop in GNATprove 2019-12-13 Yannick Moy gcc/ada/ * sem_res.adb (Resolve_Call): Prevent inlining inside while loop conditions. * sem_util.adb, sem_util.ads (In_While_Loop_Condition): New query function. From-SVN: r279347 --- gcc/ada/ChangeLog | 7 +++++++ gcc/ada/sem_res.adb | 8 ++++++++ gcc/ada/sem_util.adb | 24 ++++++++++++++++++++++++ gcc/ada/sem_util.ads | 3 +++ 4 files changed, 42 insertions(+) (limited to 'gcc/ada') diff --git a/gcc/ada/ChangeLog b/gcc/ada/ChangeLog index 209a2d4..b5834a9 100644 --- a/gcc/ada/ChangeLog +++ b/gcc/ada/ChangeLog @@ -1,3 +1,10 @@ +2019-12-13 Yannick Moy + + * sem_res.adb (Resolve_Call): Prevent inlining inside while loop + conditions. + * sem_util.adb, sem_util.ads (In_While_Loop_Condition): New + query function. + 2019-12-13 Bob Duff * impunit.ads: Add Ada_202X_Unit. diff --git a/gcc/ada/sem_res.adb b/gcc/ada/sem_res.adb index 0bdbc25..11b5316 100644 --- a/gcc/ada/sem_res.adb +++ b/gcc/ada/sem_res.adb @@ -7172,6 +7172,14 @@ package body Sem_Res is ("cannot inline & (in potentially unevaluated context)?", N, Nam_UA); + -- Calls cannot be inlined inside the conditions of while + -- loops, as this would create complex actions inside + -- the condition, that are not handled by GNATprove. + + elsif In_While_Loop_Condition (N) then + Cannot_Inline + ("cannot inline & (in while loop condition)?", N, Nam_UA); + -- Do not inline calls which would possibly lead to missing a -- type conversion check on an input parameter. diff --git a/gcc/ada/sem_util.adb b/gcc/ada/sem_util.adb index ea87a3a..03ce7c0 100644 --- a/gcc/ada/sem_util.adb +++ b/gcc/ada/sem_util.adb @@ -12855,6 +12855,30 @@ package body Sem_Util is and then not In_Private_Part (Scope_Id); end In_Visible_Part; + ----------------------------- + -- In_While_Loop_Condition -- + ----------------------------- + + function In_While_Loop_Condition (N : Node_Id) return Boolean is + Prev : Node_Id := N; + P : Node_Id := Parent (N); + -- P and Prev will be used for traversing the AST, while maintaining an + -- invariant that P = Parent (Prev). + begin + loop + if No (P) then + return False; + elsif Nkind (P) = N_Iteration_Scheme + and then Prev = Condition (P) + then + return True; + else + Prev := P; + P := Parent (P); + end if; + end loop; + end In_While_Loop_Condition; + -------------------------------- -- Incomplete_Or_Partial_View -- -------------------------------- diff --git a/gcc/ada/sem_util.ads b/gcc/ada/sem_util.ads index ace843e..ea963de 100644 --- a/gcc/ada/sem_util.ads +++ b/gcc/ada/sem_util.ads @@ -1446,6 +1446,9 @@ package Sem_Util is -- package specification. The package must be on the scope stack, and the -- corresponding private part must not. + function In_While_Loop_Condition (N : Node_Id) return Boolean; + -- Returns true if the expression N occurs within the condition of a while + function Incomplete_Or_Partial_View (Id : Entity_Id) return Entity_Id; -- Given the entity of a constant or a type, retrieve the incomplete or -- partial view of the same entity. Note that Id may not have a partial -- cgit v1.1 From 0a8ff576dbd2806fef992e52e1148a84dabebe5d Mon Sep 17 00:00:00 2001 From: Yannick Moy Date: Fri, 13 Dec 2019 09:04:01 +0000 Subject: [Ada] Avoid spurious errors on Global/Depends in instantiations 2019-12-13 Yannick Moy gcc/ada/ * sem_prag.adb (Analyze_Depends_In_Decl_Part, Analyze_Global_In_Decl_Part, Analyze_Refined_Depends_In_Decl_Part, Analyze_Refined_Global_In_Decl_Part, Check_Missing_Part_Of): Skip redundant checking involving visibility inside instantiations. From-SVN: r279348 --- gcc/ada/ChangeLog | 9 ++++++++ gcc/ada/sem_prag.adb | 61 ++++++++++++++++++++++------------------------------ 2 files changed, 35 insertions(+), 35 deletions(-) (limited to 'gcc/ada') diff --git a/gcc/ada/ChangeLog b/gcc/ada/ChangeLog index b5834a9..598b201 100644 --- a/gcc/ada/ChangeLog +++ b/gcc/ada/ChangeLog @@ -1,5 +1,14 @@ 2019-12-13 Yannick Moy + * sem_prag.adb (Analyze_Depends_In_Decl_Part, + Analyze_Global_In_Decl_Part, + Analyze_Refined_Depends_In_Decl_Part, + Analyze_Refined_Global_In_Decl_Part, Check_Missing_Part_Of): + Skip redundant checking involving visibility inside + instantiations. + +2019-12-13 Yannick Moy + * sem_res.adb (Resolve_Call): Prevent inlining inside while loop conditions. * sem_util.adb, sem_util.ads (In_While_Loop_Condition): New diff --git a/gcc/ada/sem_prag.adb b/gcc/ada/sem_prag.adb index 7b36f8e..d1d4747 100644 --- a/gcc/ada/sem_prag.adb +++ b/gcc/ada/sem_prag.adb @@ -1091,7 +1091,7 @@ package body Sem_Prag is -- template is legal, do not perform this check in -- the instance to circumvent this oddity. - if Is_Generic_Instance (Spec_Id) then + if In_Instance then null; -- An abstract state with visible refinement cannot @@ -2390,7 +2390,7 @@ package body Sem_Prag is -- do not perform this check in the instance to circumvent -- this oddity. - if Is_Generic_Instance (Spec_Id) then + if In_Instance then null; -- An abstract state with visible refinement cannot appear @@ -26026,18 +26026,17 @@ package body Sem_Prag is -- matched items found in pragma Depends. procedure Check_Output_States - (Spec_Id : Entity_Id; - Spec_Inputs : Elist_Id; + (Spec_Inputs : Elist_Id; Spec_Outputs : Elist_Id; Body_Inputs : Elist_Id; Body_Outputs : Elist_Id); -- Determine whether pragma Depends contains an output state with a -- visible refinement and if so, ensure that pragma Refined_Depends - -- mentions all its constituents as outputs. Spec_Id is the entity of - -- the related subprograms. Spec_Inputs and Spec_Outputs denote the - -- inputs and outputs of the subprogram spec synthesized from pragma - -- Depends. Body_Inputs and Body_Outputs denote the inputs and outputs - -- of the subprogram body synthesized from pragma Refined_Depends. + -- mentions all its constituents as outputs. Spec_Inputs and + -- Spec_Outputs denote the inputs and outputs of the subprogram spec + -- synthesized from pragma Depends. Body_Inputs and Body_Outputs denote + -- the inputs and outputs of the subprogram body synthesized from pragma + -- Refined_Depends. function Collect_States (Clauses : List_Id) return Elist_Id; -- Given a normalized list of dependencies obtained from calling @@ -26059,11 +26058,8 @@ package body Sem_Prag is -- all special cases. Matched_Items contains the entities of all matched -- items found in pragma Depends. - procedure Report_Extra_Clauses - (Spec_Id : Entity_Id; - Clauses : List_Id); - -- Emit an error for each extra clause found in list Clauses. Spec_Id - -- denotes the entity of the related subprogram. + procedure Report_Extra_Clauses (Clauses : List_Id); + -- Emit an error for each extra clause found in list Clauses ----------------------------- -- Check_Dependency_Clause -- @@ -26327,7 +26323,7 @@ package body Sem_Prag is -- Do not perform this check in an instance because it was already -- performed successfully in the generic template. - if Is_Generic_Instance (Spec_Id) then + if In_Instance then return; end if; @@ -26494,8 +26490,7 @@ package body Sem_Prag is ------------------------- procedure Check_Output_States - (Spec_Id : Entity_Id; - Spec_Inputs : Elist_Id; + (Spec_Inputs : Elist_Id; Spec_Outputs : Elist_Id; Body_Inputs : Elist_Id; Body_Outputs : Elist_Id) @@ -26588,7 +26583,7 @@ package body Sem_Prag is -- Do not perform this check in an instance because it was already -- performed successfully in the generic template. - if Is_Generic_Instance (Spec_Id) then + if In_Instance then null; -- Inspect the outputs of pragma Depends looking for a state with a @@ -26933,17 +26928,14 @@ package body Sem_Prag is -- Report_Extra_Clauses -- -------------------------- - procedure Report_Extra_Clauses - (Spec_Id : Entity_Id; - Clauses : List_Id) - is + procedure Report_Extra_Clauses (Clauses : List_Id) is Clause : Node_Id; begin -- Do not perform this check in an instance because it was already -- performed successfully in the generic template. - if Is_Generic_Instance (Spec_Id) then + if In_Instance then null; elsif Present (Clauses) then @@ -27078,8 +27070,7 @@ package body Sem_Prag is -- constituents appear as outputs in the dependency refinement. Check_Output_States - (Spec_Id => Spec_Id, - Spec_Inputs => Spec_Inputs, + (Spec_Inputs => Spec_Inputs, Spec_Outputs => Spec_Outputs, Body_Inputs => Body_Inputs, Body_Outputs => Body_Outputs); @@ -27149,7 +27140,7 @@ package body Sem_Prag is Remove_Extra_Clauses (Refinements, Matched_Items); if Serious_Errors_Detected = Errors then - Report_Extra_Clauses (Spec_Id, Refinements); + Report_Extra_Clauses (Refinements); end if; end if; @@ -27402,7 +27393,7 @@ package body Sem_Prag is -- Do not perform this check in an instance because it was already -- performed successfully in the generic template. - if Is_Generic_Instance (Spec_Id) then + if In_Instance then null; -- Inspect the In_Out items of the corresponding Global pragma @@ -27511,7 +27502,7 @@ package body Sem_Prag is -- Do not perform this check in an instance because it was already -- performed successfully in the generic template. - if Is_Generic_Instance (Spec_Id) then + if In_Instance then null; -- Inspect the Input items of the corresponding Global pragma looking @@ -27634,7 +27625,7 @@ package body Sem_Prag is -- Do not perform this check in an instance because it was already -- performed successfully in the generic template. - if Is_Generic_Instance (Spec_Id) then + if In_Instance then null; -- Inspect the Output items of the corresponding Global pragma @@ -27740,7 +27731,7 @@ package body Sem_Prag is -- Do not perform this check in an instance because it was already -- performed successfully in the generic template. - if Is_Generic_Instance (Spec_Id) then + if In_Instance then null; -- Inspect the Proof_In items of the corresponding Global pragma @@ -27906,7 +27897,7 @@ package body Sem_Prag is -- Do not perform this check in an instance because it was already -- performed successfully in the generic template. - if Is_Generic_Instance (Spec_Id) then + if In_Instance then null; elsif Nkind (List) = N_Null then @@ -28157,7 +28148,7 @@ package body Sem_Prag is -- Do not perform this check in an instance because it was already -- performed successfully in the generic template. - if Is_Generic_Instance (Spec_Id) then + if In_Instance then null; else @@ -28180,7 +28171,7 @@ package body Sem_Prag is -- Do not perform this check in an instance because it was already -- performed successfully in the generic template. - if Is_Generic_Instance (Spec_Id) then + if In_Instance then null; else @@ -28244,7 +28235,7 @@ package body Sem_Prag is -- body contract is instantiated. Since the generic template is legal, -- do not perform this check in the instance to circumvent this oddity. - if Is_Generic_Instance (Spec_Id) then + if In_Instance then null; -- Non-instance case @@ -28360,7 +28351,7 @@ package body Sem_Prag is -- in the generic template. if Serious_Errors_Detected = Errors - and then not Is_Generic_Instance (Spec_Id) + and then not In_Instance and then not Has_Null_State and then No_Constit then -- cgit v1.1 From 7f8ad8f001a4054e07b7d0762a14a6784bec136c Mon Sep 17 00:00:00 2001 From: Ed Schonberg Date: Fri, 13 Dec 2019 09:04:06 +0000 Subject: [Ada] Crash on inherited private operation in child package 2019-12-13 Ed Schonberg gcc/ada/ * sem_ch7.adb (Analyze_Package_Body_Helper): Do not call Declare_Inherited_Private_Subprograms on s child body: the required operations have already been created when analyzing the corresponding package declaration. This prevents a redeclaration of inehrited operation, and a crash when inserting the new operation in the current scope. From-SVN: r279349 --- gcc/ada/ChangeLog | 9 +++++++++ gcc/ada/sem_ch7.adb | 3 +++ 2 files changed, 12 insertions(+) (limited to 'gcc/ada') diff --git a/gcc/ada/ChangeLog b/gcc/ada/ChangeLog index 598b201..1da3ebc 100644 --- a/gcc/ada/ChangeLog +++ b/gcc/ada/ChangeLog @@ -1,3 +1,12 @@ +2019-12-13 Ed Schonberg + + * sem_ch7.adb (Analyze_Package_Body_Helper): Do not call + Declare_Inherited_Private_Subprograms on s child body: the + required operations have already been created when analyzing the + corresponding package declaration. This prevents a redeclaration + of inehrited operation, and a crash when inserting the new + operation in the current scope. + 2019-12-13 Yannick Moy * sem_prag.adb (Analyze_Depends_In_Decl_Part, diff --git a/gcc/ada/sem_ch7.adb b/gcc/ada/sem_ch7.adb index 313cb4e..6d9a1db 100644 --- a/gcc/ada/sem_ch7.adb +++ b/gcc/ada/sem_ch7.adb @@ -925,9 +925,12 @@ package body Sem_Ch7 is -- This is a nested package, so it may be necessary to declare certain -- inherited subprograms that are not yet visible because the parent -- type's subprograms are now visible. + -- Note that for child units these operations were generated when + -- analyzing the package specification. if Ekind (Scope (Spec_Id)) = E_Package and then Scope (Spec_Id) /= Standard_Standard + and then not Is_Child_Unit (Spec_Id) then Declare_Inherited_Private_Subprograms (Spec_Id); end if; -- cgit v1.1 From 6c9e4a1d65bc7ff2747f714ebb48a41827f4f74b Mon Sep 17 00:00:00 2001 From: Bob Duff Date: Fri, 13 Dec 2019 09:04:12 +0000 Subject: [Ada] Remove Is_Available function 2019-12-13 Bob Duff gcc/ada/ * exp_attr.adb (Is_Available): Remove this function, and replace all calls with RTE_Available. RTE_Available will return True if "not Configurable_Run_Time_Mode". Remove the "???" comment. From-SVN: r279350 --- gcc/ada/ChangeLog | 6 +++ gcc/ada/exp_attr.adb | 107 ++++++++++++++++++++------------------------------- 2 files changed, 47 insertions(+), 66 deletions(-) (limited to 'gcc/ada') diff --git a/gcc/ada/ChangeLog b/gcc/ada/ChangeLog index 1da3ebc..475a389 100644 --- a/gcc/ada/ChangeLog +++ b/gcc/ada/ChangeLog @@ -1,3 +1,9 @@ +2019-12-13 Bob Duff + + * exp_attr.adb (Is_Available): Remove this function, and replace + all calls with RTE_Available. RTE_Available will return True if + "not Configurable_Run_Time_Mode". Remove the "???" comment. + 2019-12-13 Ed Schonberg * sem_ch7.adb (Analyze_Package_Body_Helper): Do not call diff --git a/gcc/ada/exp_attr.adb b/gcc/ada/exp_attr.adb index c7b6451..7701d72 100644 --- a/gcc/ada/exp_attr.adb +++ b/gcc/ada/exp_attr.adb @@ -7818,31 +7818,6 @@ package body Exp_Attr is is Base_Typ : constant Entity_Id := Base_Type (Typ); Ent : constant Entity_Id := TSS (Typ, Nam); - - function Is_Available (Entity : RE_Id) return Boolean; - pragma Inline (Is_Available); - -- Function to check whether the specified run-time call is available - -- in the run time used. In the case of a configurable run time, it - -- is normal that some subprograms are not there. - -- - -- I don't understand this routine at all, why is this not just a - -- call to RTE_Available? And if for some reason we need a different - -- routine with different semantics, why is not in Rtsfind ??? - - ------------------ - -- Is_Available -- - ------------------ - - function Is_Available (Entity : RE_Id) return Boolean is - begin - -- Assume that the unit will always be available when using a - -- "normal" (not configurable) run time. - - return not Configurable_Run_Time_Mode or else RTE_Available (Entity); - end Is_Available; - - -- Start of processing for Find_Stream_Subprogram - begin if Present (Ent) then return Ent; @@ -7859,7 +7834,7 @@ package body Exp_Attr is -- that stream routines for string types are not present (they require -- file system support). In this case, the specific stream routines for -- strings are not used, relying on the regular stream mechanism - -- instead. That is why we include the test Is_Available when dealing + -- instead. That is why we include the test RTE_Available when dealing -- with these cases. if not Is_Predefined_Unit (Current_Sem_Unit) then @@ -7871,22 +7846,22 @@ package body Exp_Attr is if Restriction_Active (No_Stream_Optimizations) then if Nam = TSS_Stream_Input - and then Is_Available (RE_Storage_Array_Input) + and then RTE_Available (RE_Storage_Array_Input) then return RTE (RE_Storage_Array_Input); elsif Nam = TSS_Stream_Output - and then Is_Available (RE_Storage_Array_Output) + and then RTE_Available (RE_Storage_Array_Output) then return RTE (RE_Storage_Array_Output); elsif Nam = TSS_Stream_Read - and then Is_Available (RE_Storage_Array_Read) + and then RTE_Available (RE_Storage_Array_Read) then return RTE (RE_Storage_Array_Read); elsif Nam = TSS_Stream_Write - and then Is_Available (RE_Storage_Array_Write) + and then RTE_Available (RE_Storage_Array_Write) then return RTE (RE_Storage_Array_Write); @@ -7903,22 +7878,22 @@ package body Exp_Attr is else if Nam = TSS_Stream_Input - and then Is_Available (RE_Storage_Array_Input_Blk_IO) + and then RTE_Available (RE_Storage_Array_Input_Blk_IO) then return RTE (RE_Storage_Array_Input_Blk_IO); elsif Nam = TSS_Stream_Output - and then Is_Available (RE_Storage_Array_Output_Blk_IO) + and then RTE_Available (RE_Storage_Array_Output_Blk_IO) then return RTE (RE_Storage_Array_Output_Blk_IO); elsif Nam = TSS_Stream_Read - and then Is_Available (RE_Storage_Array_Read_Blk_IO) + and then RTE_Available (RE_Storage_Array_Read_Blk_IO) then return RTE (RE_Storage_Array_Read_Blk_IO); elsif Nam = TSS_Stream_Write - and then Is_Available (RE_Storage_Array_Write_Blk_IO) + and then RTE_Available (RE_Storage_Array_Write_Blk_IO) then return RTE (RE_Storage_Array_Write_Blk_IO); @@ -7939,22 +7914,22 @@ package body Exp_Attr is if Restriction_Active (No_Stream_Optimizations) then if Nam = TSS_Stream_Input - and then Is_Available (RE_Stream_Element_Array_Input) + and then RTE_Available (RE_Stream_Element_Array_Input) then return RTE (RE_Stream_Element_Array_Input); elsif Nam = TSS_Stream_Output - and then Is_Available (RE_Stream_Element_Array_Output) + and then RTE_Available (RE_Stream_Element_Array_Output) then return RTE (RE_Stream_Element_Array_Output); elsif Nam = TSS_Stream_Read - and then Is_Available (RE_Stream_Element_Array_Read) + and then RTE_Available (RE_Stream_Element_Array_Read) then return RTE (RE_Stream_Element_Array_Read); elsif Nam = TSS_Stream_Write - and then Is_Available (RE_Stream_Element_Array_Write) + and then RTE_Available (RE_Stream_Element_Array_Write) then return RTE (RE_Stream_Element_Array_Write); @@ -7971,22 +7946,22 @@ package body Exp_Attr is else if Nam = TSS_Stream_Input - and then Is_Available (RE_Stream_Element_Array_Input_Blk_IO) + and then RTE_Available (RE_Stream_Element_Array_Input_Blk_IO) then return RTE (RE_Stream_Element_Array_Input_Blk_IO); elsif Nam = TSS_Stream_Output - and then Is_Available (RE_Stream_Element_Array_Output_Blk_IO) + and then RTE_Available (RE_Stream_Element_Array_Output_Blk_IO) then return RTE (RE_Stream_Element_Array_Output_Blk_IO); elsif Nam = TSS_Stream_Read - and then Is_Available (RE_Stream_Element_Array_Read_Blk_IO) + and then RTE_Available (RE_Stream_Element_Array_Read_Blk_IO) then return RTE (RE_Stream_Element_Array_Read_Blk_IO); elsif Nam = TSS_Stream_Write - and then Is_Available (RE_Stream_Element_Array_Write_Blk_IO) + and then RTE_Available (RE_Stream_Element_Array_Write_Blk_IO) then return RTE (RE_Stream_Element_Array_Write_Blk_IO); @@ -8007,22 +7982,22 @@ package body Exp_Attr is if Restriction_Active (No_Stream_Optimizations) then if Nam = TSS_Stream_Input - and then Is_Available (RE_String_Input) + and then RTE_Available (RE_String_Input) then return RTE (RE_String_Input); elsif Nam = TSS_Stream_Output - and then Is_Available (RE_String_Output) + and then RTE_Available (RE_String_Output) then return RTE (RE_String_Output); elsif Nam = TSS_Stream_Read - and then Is_Available (RE_String_Read) + and then RTE_Available (RE_String_Read) then return RTE (RE_String_Read); elsif Nam = TSS_Stream_Write - and then Is_Available (RE_String_Write) + and then RTE_Available (RE_String_Write) then return RTE (RE_String_Write); @@ -8039,22 +8014,22 @@ package body Exp_Attr is else if Nam = TSS_Stream_Input - and then Is_Available (RE_String_Input_Blk_IO) + and then RTE_Available (RE_String_Input_Blk_IO) then return RTE (RE_String_Input_Blk_IO); elsif Nam = TSS_Stream_Output - and then Is_Available (RE_String_Output_Blk_IO) + and then RTE_Available (RE_String_Output_Blk_IO) then return RTE (RE_String_Output_Blk_IO); elsif Nam = TSS_Stream_Read - and then Is_Available (RE_String_Read_Blk_IO) + and then RTE_Available (RE_String_Read_Blk_IO) then return RTE (RE_String_Read_Blk_IO); elsif Nam = TSS_Stream_Write - and then Is_Available (RE_String_Write_Blk_IO) + and then RTE_Available (RE_String_Write_Blk_IO) then return RTE (RE_String_Write_Blk_IO); @@ -8075,22 +8050,22 @@ package body Exp_Attr is if Restriction_Active (No_Stream_Optimizations) then if Nam = TSS_Stream_Input - and then Is_Available (RE_Wide_String_Input) + and then RTE_Available (RE_Wide_String_Input) then return RTE (RE_Wide_String_Input); elsif Nam = TSS_Stream_Output - and then Is_Available (RE_Wide_String_Output) + and then RTE_Available (RE_Wide_String_Output) then return RTE (RE_Wide_String_Output); elsif Nam = TSS_Stream_Read - and then Is_Available (RE_Wide_String_Read) + and then RTE_Available (RE_Wide_String_Read) then return RTE (RE_Wide_String_Read); elsif Nam = TSS_Stream_Write - and then Is_Available (RE_Wide_String_Write) + and then RTE_Available (RE_Wide_String_Write) then return RTE (RE_Wide_String_Write); @@ -8107,22 +8082,22 @@ package body Exp_Attr is else if Nam = TSS_Stream_Input - and then Is_Available (RE_Wide_String_Input_Blk_IO) + and then RTE_Available (RE_Wide_String_Input_Blk_IO) then return RTE (RE_Wide_String_Input_Blk_IO); elsif Nam = TSS_Stream_Output - and then Is_Available (RE_Wide_String_Output_Blk_IO) + and then RTE_Available (RE_Wide_String_Output_Blk_IO) then return RTE (RE_Wide_String_Output_Blk_IO); elsif Nam = TSS_Stream_Read - and then Is_Available (RE_Wide_String_Read_Blk_IO) + and then RTE_Available (RE_Wide_String_Read_Blk_IO) then return RTE (RE_Wide_String_Read_Blk_IO); elsif Nam = TSS_Stream_Write - and then Is_Available (RE_Wide_String_Write_Blk_IO) + and then RTE_Available (RE_Wide_String_Write_Blk_IO) then return RTE (RE_Wide_String_Write_Blk_IO); @@ -8143,22 +8118,22 @@ package body Exp_Attr is if Restriction_Active (No_Stream_Optimizations) then if Nam = TSS_Stream_Input - and then Is_Available (RE_Wide_Wide_String_Input) + and then RTE_Available (RE_Wide_Wide_String_Input) then return RTE (RE_Wide_Wide_String_Input); elsif Nam = TSS_Stream_Output - and then Is_Available (RE_Wide_Wide_String_Output) + and then RTE_Available (RE_Wide_Wide_String_Output) then return RTE (RE_Wide_Wide_String_Output); elsif Nam = TSS_Stream_Read - and then Is_Available (RE_Wide_Wide_String_Read) + and then RTE_Available (RE_Wide_Wide_String_Read) then return RTE (RE_Wide_Wide_String_Read); elsif Nam = TSS_Stream_Write - and then Is_Available (RE_Wide_Wide_String_Write) + and then RTE_Available (RE_Wide_Wide_String_Write) then return RTE (RE_Wide_Wide_String_Write); @@ -8175,22 +8150,22 @@ package body Exp_Attr is else if Nam = TSS_Stream_Input - and then Is_Available (RE_Wide_Wide_String_Input_Blk_IO) + and then RTE_Available (RE_Wide_Wide_String_Input_Blk_IO) then return RTE (RE_Wide_Wide_String_Input_Blk_IO); elsif Nam = TSS_Stream_Output - and then Is_Available (RE_Wide_Wide_String_Output_Blk_IO) + and then RTE_Available (RE_Wide_Wide_String_Output_Blk_IO) then return RTE (RE_Wide_Wide_String_Output_Blk_IO); elsif Nam = TSS_Stream_Read - and then Is_Available (RE_Wide_Wide_String_Read_Blk_IO) + and then RTE_Available (RE_Wide_Wide_String_Read_Blk_IO) then return RTE (RE_Wide_Wide_String_Read_Blk_IO); elsif Nam = TSS_Stream_Write - and then Is_Available (RE_Wide_Wide_String_Write_Blk_IO) + and then RTE_Available (RE_Wide_Wide_String_Write_Blk_IO) then return RTE (RE_Wide_Wide_String_Write_Blk_IO); -- cgit v1.1 From 20dc266e5a178fd87bb8ae6ebbf63e391f74e9b0 Mon Sep 17 00:00:00 2001 From: Javier Miranda Date: Fri, 13 Dec 2019 09:04:18 +0000 Subject: [Ada] Deallocation of controlled type implementing interface types 2019-12-13 Javier Miranda gcc/ada/ * exp_disp.ads (Expand_Interface_Thunk): Adding one formal (the interface type). * exp_disp.adb (Expand_Interface_Thunk): Using the added formal to ensure the correct profile of the thunk generated for predefined primitives; in addition, the added formal is also used to perform a check that ensures that the controlling type of the thunk is the one expected by the GCC backend. (Make_Secondary_DT, Register_Primitive): Adding the new formal to the calls to Expand_Interface_Thunk. * exp_ch6.adb (Register_Predefined_DT_Entry): Adding the new formal to the call to Expand_Interface_Thunk. * exp_intr.adb (Expand_Unc_Deallocation): When deallocating a controlled type and the call to unchecked deallocation is performed with a pointer to one of the convered interface types, displace the pointer to the object to reference the base of the object to deallocate its memory. * gcc-interface/trans.c (maybe_make_gnu_thunk): Assert that the controlling type of the thunk is an interface type. From-SVN: r279351 --- gcc/ada/ChangeLog | 21 +++++++++++++++++++++ gcc/ada/exp_ch6.adb | 3 ++- gcc/ada/exp_disp.adb | 39 ++++++++++++++++++++++++++++++++++----- gcc/ada/exp_disp.ads | 3 ++- gcc/ada/exp_intr.adb | 28 +++++++++++++++++++++++++--- gcc/ada/gcc-interface/trans.c | 7 ++++--- 6 files changed, 88 insertions(+), 13 deletions(-) (limited to 'gcc/ada') diff --git a/gcc/ada/ChangeLog b/gcc/ada/ChangeLog index 475a389..b4ed0d5 100644 --- a/gcc/ada/ChangeLog +++ b/gcc/ada/ChangeLog @@ -1,3 +1,24 @@ +2019-12-13 Javier Miranda + + * exp_disp.ads (Expand_Interface_Thunk): Adding one formal (the + interface type). + * exp_disp.adb (Expand_Interface_Thunk): Using the added formal + to ensure the correct profile of the thunk generated for + predefined primitives; in addition, the added formal is also + used to perform a check that ensures that the controlling type + of the thunk is the one expected by the GCC backend. + (Make_Secondary_DT, Register_Primitive): Adding the new formal + to the calls to Expand_Interface_Thunk. + * exp_ch6.adb (Register_Predefined_DT_Entry): Adding the new + formal to the call to Expand_Interface_Thunk. + * exp_intr.adb (Expand_Unc_Deallocation): When deallocating a + controlled type and the call to unchecked deallocation is + performed with a pointer to one of the convered interface types, + displace the pointer to the object to reference the base of the + object to deallocate its memory. + * gcc-interface/trans.c (maybe_make_gnu_thunk): Assert that the + controlling type of the thunk is an interface type. + 2019-12-13 Bob Duff * exp_attr.adb (Is_Available): Remove this function, and replace diff --git a/gcc/ada/exp_ch6.adb b/gcc/ada/exp_ch6.adb index 3d6ef48..c03cd7c 100644 --- a/gcc/ada/exp_ch6.adb +++ b/gcc/ada/exp_ch6.adb @@ -7607,7 +7607,8 @@ package body Exp_Ch6 is and then Ekind (Node (Iface_DT_Ptr)) = E_Constant loop pragma Assert (Has_Thunks (Node (Iface_DT_Ptr))); - Expand_Interface_Thunk (Prim, Thunk_Id, Thunk_Code); + Expand_Interface_Thunk (Prim, Thunk_Id, Thunk_Code, + Iface => Related_Type (Node (Iface_DT_Ptr))); if Present (Thunk_Code) then Insert_Actions_After (N, New_List ( diff --git a/gcc/ada/exp_disp.adb b/gcc/ada/exp_disp.adb index 84caa92..4663a08 100644 --- a/gcc/ada/exp_disp.adb +++ b/gcc/ada/exp_disp.adb @@ -1850,7 +1850,8 @@ package body Exp_Disp is procedure Expand_Interface_Thunk (Prim : Node_Id; Thunk_Id : out Entity_Id; - Thunk_Code : out Node_Id) + Thunk_Code : out Node_Id; + Iface : Entity_Id) is Loc : constant Source_Ptr := Sloc (Prim); Actuals : constant List_Id := New_List; @@ -1912,12 +1913,38 @@ package body Exp_Disp is -- Use the interface type as the type of the controlling formal (see -- comment above). - if not Is_Controlling_Formal (Formal) or else Is_Predef_Op then + if not Is_Controlling_Formal (Formal) then Ftyp := Etype (Formal); Expr := New_Copy_Tree (Expression (Parent (Formal))); + + -- For predefined primitives the controlling type of the thunk is + -- the interface type passed by the caller (since they don't have + -- available the Interface_Alias attribute; see comment above). + + elsif Is_Predef_Op then + Ftyp := Iface; + Expr := Empty; + else Ftyp := Etype (Iface_Formal); Expr := Empty; + + -- Sanity check performed to ensure the proper controlling type + -- when the thunk has exactly one controlling parameter and it + -- comes first. In such case the GCC backend reuses the C++ + -- thunks machinery which perform a computation equivalent to + -- the code generated by the expander; for other cases the GCC + -- backend translates the expanded code unmodified. However, as + -- a generalization, the check is performed for all controlling + -- types. + + if Is_Access_Type (Ftyp) then + pragma Assert (Base_Type (Designated_Type (Ftyp)) = Iface); + null; + else + Ftyp := Base_Type (Ftyp); + pragma Assert (Ftyp = Iface); + end if; end if; Append_To (Formals, @@ -4073,7 +4100,8 @@ package body Exp_Disp is Alias (Prim); else - Expand_Interface_Thunk (Prim, Thunk_Id, Thunk_Code); + Expand_Interface_Thunk + (Prim, Thunk_Id, Thunk_Code, Iface); if Present (Thunk_Id) then Append_To (Result, Thunk_Code); @@ -4379,7 +4407,8 @@ package body Exp_Disp is Prim_Table (Prim_Pos) := Alias (Prim); else - Expand_Interface_Thunk (Prim, Thunk_Id, Thunk_Code); + Expand_Interface_Thunk + (Prim, Thunk_Id, Thunk_Code, Iface); if Present (Thunk_Id) then Prim_Pos := @@ -7507,7 +7536,7 @@ package body Exp_Disp is return L; end if; - Expand_Interface_Thunk (Prim, Thunk_Id, Thunk_Code); + Expand_Interface_Thunk (Prim, Thunk_Id, Thunk_Code, Iface_Typ); if not Is_Ancestor (Iface_Typ, Tag_Typ, Use_Full_View => True) and then Present (Thunk_Code) diff --git a/gcc/ada/exp_disp.ads b/gcc/ada/exp_disp.ads index 7295942..5c490df 100644 --- a/gcc/ada/exp_disp.ads +++ b/gcc/ada/exp_disp.ads @@ -242,7 +242,8 @@ package Exp_Disp is procedure Expand_Interface_Thunk (Prim : Node_Id; Thunk_Id : out Entity_Id; - Thunk_Code : out Node_Id); + Thunk_Code : out Node_Id; + Iface : Entity_Id); -- Ada 2005 (AI-251): When a tagged type implements abstract interfaces we -- generate additional subprograms (thunks) associated with each primitive -- Prim to have a layout compatible with the C++ ABI. The thunk displaces diff --git a/gcc/ada/exp_intr.adb b/gcc/ada/exp_intr.adb index c28982c..78555bf 100644 --- a/gcc/ada/exp_intr.adb +++ b/gcc/ada/exp_intr.adb @@ -988,9 +988,31 @@ package body Exp_Intr is -- are allowed, the generated code may lack block statements. if Needs_Fin then - Obj_Ref := - Make_Explicit_Dereference (Loc, - Prefix => Duplicate_Subexpr_No_Checks (Arg)); + + -- Ada 2005 (AI-251): In case of abstract interface type we displace + -- the pointer to reference the base of the object to deallocate its + -- memory, unless we're targetting a VM, in which case no special + -- processing is required. + + if Is_Interface (Directly_Designated_Type (Typ)) + and then Tagged_Type_Expansion + then + Obj_Ref := + Make_Explicit_Dereference (Loc, + Prefix => + Unchecked_Convert_To (Typ, + Make_Function_Call (Loc, + Name => + New_Occurrence_Of (RTE (RE_Base_Address), Loc), + Parameter_Associations => New_List ( + Unchecked_Convert_To (RTE (RE_Address), + Duplicate_Subexpr_No_Checks (Arg)))))); + + else + Obj_Ref := + Make_Explicit_Dereference (Loc, + Prefix => Duplicate_Subexpr_No_Checks (Arg)); + end if; -- If the designated type is tagged, the finalization call must -- dispatch because the designated type may not be the actual type diff --git a/gcc/ada/gcc-interface/trans.c b/gcc/ada/gcc-interface/trans.c index 3d6f381..ef16a08 100644 --- a/gcc/ada/gcc-interface/trans.c +++ b/gcc/ada/gcc-interface/trans.c @@ -11287,11 +11287,12 @@ maybe_make_gnu_thunk (Entity_Id gnat_thunk, tree gnu_thunk) const Entity_Id gnat_controlling_type = get_controlling_type (gnat_target); const Entity_Id gnat_interface_type = get_controlling_type (gnat_thunk); + /* We must have an interface type at this point. */ + gcc_assert (Is_Interface (gnat_interface_type)); + /* Now compute whether the former covers the latter. */ const Entity_Id gnat_interface_tag - = Is_Interface (gnat_interface_type) - ? Find_Interface_Tag (gnat_controlling_type, gnat_interface_type) - : Empty; + = Find_Interface_Tag (gnat_controlling_type, gnat_interface_type); tree gnu_interface_tag = Present (gnat_interface_tag) ? gnat_to_gnu_field_decl (gnat_interface_tag) -- cgit v1.1 From be3614c740f91caf593e77b7138e65013fc0487b Mon Sep 17 00:00:00 2001 From: Ed Schonberg Date: Fri, 13 Dec 2019 09:04:23 +0000 Subject: [Ada] Crash on implicit dereference not made explicit 2019-12-13 Ed Schonberg gcc/ada/ * sem_res.adb (Resolve): IF an entity reference is overloaded because its type has an Implicit_Dereference aspect, we must examine the discriminants of the type to determine whether an explicit dereference must be inserted for use in code generation. Previously this was done for other expressions but not for entity references by themselves. This was sufficient to handle uses of the aspect in container handling and iteration, but not more generally. From-SVN: r279352 --- gcc/ada/ChangeLog | 11 +++++++++++ gcc/ada/sem_res.adb | 36 +++++++++++++++++++++++++++++++----- 2 files changed, 42 insertions(+), 5 deletions(-) (limited to 'gcc/ada') diff --git a/gcc/ada/ChangeLog b/gcc/ada/ChangeLog index b4ed0d5..9cb8f79 100644 --- a/gcc/ada/ChangeLog +++ b/gcc/ada/ChangeLog @@ -1,3 +1,14 @@ +2019-12-13 Ed Schonberg + + * sem_res.adb (Resolve): IF an entity reference is overloaded + because its type has an Implicit_Dereference aspect, we must + examine the discriminants of the type to determine whether an + explicit dereference must be inserted for use in code + generation. Previously this was done for other expressions but + not for entity references by themselves. This was sufficient to + handle uses of the aspect in container handling and iteration, + but not more generally. + 2019-12-13 Javier Miranda * exp_disp.ads (Expand_Interface_Thunk): Adding one formal (the diff --git a/gcc/ada/sem_res.adb b/gcc/ada/sem_res.adb index 11b5316..3568a89 100644 --- a/gcc/ada/sem_res.adb +++ b/gcc/ada/sem_res.adb @@ -2640,17 +2640,43 @@ package body Sem_Res is Set_Etype (N, Expr_Type); -- AI05-0139-2: Expression is overloaded because type has - -- implicit dereference. If type matches context, no implicit - -- dereference is involved. If the expression is an entity, - -- generate a reference to it, as this is not done for an - -- overloaded construct during analysis. + -- implicit dereference. The context may be the one that + -- requires implicit dereferemce. elsif Has_Implicit_Dereference (Expr_Type) then Set_Etype (N, Expr_Type); Set_Is_Overloaded (N, False); - if Is_Entity_Name (N) then + -- If the expression is an entity, generate a reference + -- to it, as this is not done for an overloaded construct + -- during analysis. + + if Is_Entity_Name (N) + and then Comes_From_Source (N) + then Generate_Reference (Entity (N), N); + + -- Examine access discriminants of entity type, + -- to check whether one of them yields the + -- expected type. + + declare + Disc : Entity_Id := + First_Discriminant (Etype (Entity (N))); + + begin + while Present (Disc) loop + exit when Is_Access_Type (Etype (Disc)) + and then Has_Implicit_Dereference (Disc) + and then Designated_Type (Etype (Disc)) = Typ; + + Next_Discriminant (Disc); + end loop; + + if Present (Disc) then + Build_Explicit_Dereference (N, Disc); + end if; + end; end if; exit Interp_Loop; -- cgit v1.1 From 47997d257aaaac802d5857c898a4a3ef38e9e65a Mon Sep 17 00:00:00 2001 From: Gary Dismukes Date: Fri, 13 Dec 2019 09:04:28 +0000 Subject: [Ada] Suppress Base_Address call on init of activation record components 2019-12-13 Gary Dismukes gcc/ada/ * exp_attr.adb (Expand_N_Attribute_Reference, Attribute_Address): Suppress generation of a call to Base_Address in the case where the Address attribute is being used to initialize a corresponding component of an activation record. (Is_Unnested_Component_Init): New function to determine whether an attribute reference for Address is used to initialized a component of an activation record object that corresponds to the object denoted by the prefix of the attribute (an assignment used in support of unnesting for back ends like LLVM). From-SVN: r279353 --- gcc/ada/ChangeLog | 13 +++++++++++++ gcc/ada/exp_attr.adb | 26 +++++++++++++++++++++++++- 2 files changed, 38 insertions(+), 1 deletion(-) (limited to 'gcc/ada') diff --git a/gcc/ada/ChangeLog b/gcc/ada/ChangeLog index 9cb8f79..9838e9b 100644 --- a/gcc/ada/ChangeLog +++ b/gcc/ada/ChangeLog @@ -1,3 +1,16 @@ +2019-12-13 Gary Dismukes + + * exp_attr.adb (Expand_N_Attribute_Reference, + Attribute_Address): Suppress generation of a call to + Base_Address in the case where the Address attribute is being + used to initialize a corresponding component of an activation + record. + (Is_Unnested_Component_Init): New function to determine whether + an attribute reference for Address is used to initialized a + component of an activation record object that corresponds to the + object denoted by the prefix of the attribute (an assignment + used in support of unnesting for back ends like LLVM). + 2019-12-13 Ed Schonberg * sem_res.adb (Resolve): IF an entity reference is overloaded diff --git a/gcc/ada/exp_attr.adb b/gcc/ada/exp_attr.adb index 7701d72..8c5981a 100644 --- a/gcc/ada/exp_attr.adb +++ b/gcc/ada/exp_attr.adb @@ -2316,6 +2316,24 @@ package body Exp_Attr is when Attribute_Address => Address : declare Task_Proc : Entity_Id; + function Is_Unnested_Component_Init (N : Node_Id) return Boolean; + -- Returns True if N is being used to initialize a component of + -- an activation record object where the component corresponds to + -- the object denoted by the prefix of the attribute N. + + function Is_Unnested_Component_Init (N : Node_Id) return Boolean is + begin + return Present (Parent (N)) + and then Nkind (Parent (N)) = N_Assignment_Statement + and then Is_Entity_Name (Pref) + and then Present (Activation_Record_Component (Entity (Pref))) + and then Nkind (Name (Parent (N))) = N_Selected_Component + and then Entity (Selector_Name (Name (Parent (N)))) = + Activation_Record_Component (Entity (Pref)); + end Is_Unnested_Component_Init; + + -- Start of processing for Address + begin -- If the prefix is a task or a task type, the useful address is that -- of the procedure for the task body, i.e. the actual program unit. @@ -2379,13 +2397,19 @@ package body Exp_Attr is -- "displaced" to reference the tag associated with the interface -- type. In order to obtain the real address of such objects we -- generate a call to a run-time subprogram that returns the base - -- address of the object. + -- address of the object. This call is not generated in cases where + -- the attribute is being used to initialize a component of an + -- activation record object where the component corresponds to + -- prefix of the attribute (for back ends that require "unnesting" + -- of nested subprograms), since the address needs to be assigned + -- as-is to such components. elsif Is_Class_Wide_Type (Ptyp) and then Is_Interface (Underlying_Type (Ptyp)) and then Tagged_Type_Expansion and then not (Nkind (Pref) in N_Has_Entity and then Is_Subprogram (Entity (Pref))) + and then not Is_Unnested_Component_Init (N) then Rewrite (N, Make_Function_Call (Loc, -- cgit v1.1 From 63e21a7237fac8dfedda51cc7f4089e8c07a25e9 Mon Sep 17 00:00:00 2001 From: Eric Botcazou Date: Fri, 13 Dec 2019 09:04:33 +0000 Subject: [Ada] Minor tweak to Volatile_Full_Access wording in GNAT RM 2019-12-13 Eric Botcazou gcc/ada/ * doc/gnat_rm/implementation_defined_pragmas.rst: Minor tweak to Volatile_Full_Access wording in GNAT RM. * gnat_rm.texi: Regenerate. From-SVN: r279354 --- gcc/ada/ChangeLog | 6 ++++++ gcc/ada/doc/gnat_rm/implementation_defined_pragmas.rst | 6 +++--- gcc/ada/gnat_rm.texi | 8 ++++---- 3 files changed, 13 insertions(+), 7 deletions(-) (limited to 'gcc/ada') diff --git a/gcc/ada/ChangeLog b/gcc/ada/ChangeLog index 9838e9b..97b6469 100644 --- a/gcc/ada/ChangeLog +++ b/gcc/ada/ChangeLog @@ -1,3 +1,9 @@ +2019-12-13 Eric Botcazou + + * doc/gnat_rm/implementation_defined_pragmas.rst: Minor tweak to + Volatile_Full_Access wording in GNAT RM. + * gnat_rm.texi: Regenerate. + 2019-12-13 Gary Dismukes * exp_attr.adb (Expand_N_Attribute_Reference, diff --git a/gcc/ada/doc/gnat_rm/implementation_defined_pragmas.rst b/gcc/ada/doc/gnat_rm/implementation_defined_pragmas.rst index bf0a9d4..fd66aed 100644 --- a/gcc/ada/doc/gnat_rm/implementation_defined_pragmas.rst +++ b/gcc/ada/doc/gnat_rm/implementation_defined_pragmas.rst @@ -7425,8 +7425,8 @@ Syntax: This is similar in effect to pragma Volatile, except that any reference to the object is guaranteed to be done only with instructions that read or write all the bits of the object. Furthermore, if the object is of a composite type, -then any reference to a component of the object is guaranteed to read and/or -write all the bits of the object. +then any reference to a subcomponent of the object is guaranteed to read +and/or write all the bits of the object. The intention is that this be suitable for use with memory-mapped I/O devices on some machines. Note that there are two important respects in which this is @@ -7438,7 +7438,7 @@ is not to the whole object; the compiler is allowed (and generally will) access only part of the object in this case. It is not permissible to specify ``Atomic`` and ``Volatile_Full_Access`` for -the same object. +the same type or object. It is not permissible to specify ``Volatile_Full_Access`` for a composite (record or array) type or object that has at least one ``Aliased`` component. diff --git a/gcc/ada/gnat_rm.texi b/gcc/ada/gnat_rm.texi index 2a4ad37..8d909de 100644 --- a/gcc/ada/gnat_rm.texi +++ b/gcc/ada/gnat_rm.texi @@ -21,7 +21,7 @@ @copying @quotation -GNAT Reference Manual , Sep 14, 2019 +GNAT Reference Manual , Dec 10, 2019 AdaCore @@ -8931,8 +8931,8 @@ pragma Volatile_Full_Access (LOCAL_NAME); This is similar in effect to pragma Volatile, except that any reference to the object is guaranteed to be done only with instructions that read or write all the bits of the object. Furthermore, if the object is of a composite type, -then any reference to a component of the object is guaranteed to read and/or -write all the bits of the object. +then any reference to a subcomponent of the object is guaranteed to read +and/or write all the bits of the object. The intention is that this be suitable for use with memory-mapped I/O devices on some machines. Note that there are two important respects in which this is @@ -8944,7 +8944,7 @@ is not to the whole object; the compiler is allowed (and generally will) access only part of the object in this case. It is not permissible to specify @code{Atomic} and @code{Volatile_Full_Access} for -the same object. +the same type or object. It is not permissible to specify @code{Volatile_Full_Access} for a composite (record or array) type or object that has at least one @code{Aliased} component. -- cgit v1.1 From cfedf3e51bbcfc13e014a5b1d98418fe4f50d907 Mon Sep 17 00:00:00 2001 From: Steve Baird Date: Fri, 13 Dec 2019 09:04:38 +0000 Subject: [Ada] Implement AI12-0109 (prohibit some "early" derivations) 2019-12-13 Steve Baird gcc/ada/ * einfo.ads: Correct comment for Derived_Type_Link to reflect that fact that this function is now used for more than just generation of warnings. * sem_ch3.adb (Build_Derived_Type): Do not call Set_Derived_Type_Link if the derived type and the parent type are in different compilation units. Such a derivation cannot be a problematic "early" derivation (identifying these is what the Derived_Type_Link attribute is used for) and we don't like inter-unit references that go in the opposite direction of semantic dependencies. * sem_ch13.adb (Is_Type_Related_Rep_Item): A new function, analogous to the existing function Is_Operational_Item. (Rep_Item_Too_Late): Generate a hard error (with same text as the warning that was previously being generated) if the AI12-0109 legality rule is violated. From-SVN: r279355 --- gcc/ada/ChangeLog | 18 ++++++++ gcc/ada/einfo.ads | 8 ++-- gcc/ada/sem_ch13.adb | 114 +++++++++++++++++++++++++++++++++++++++++++-------- gcc/ada/sem_ch3.adb | 14 +++++-- 4 files changed, 129 insertions(+), 25 deletions(-) (limited to 'gcc/ada') diff --git a/gcc/ada/ChangeLog b/gcc/ada/ChangeLog index 97b6469..69176db 100644 --- a/gcc/ada/ChangeLog +++ b/gcc/ada/ChangeLog @@ -1,3 +1,21 @@ +2019-12-13 Steve Baird + + * einfo.ads: Correct comment for Derived_Type_Link to reflect + that fact that this function is now used for more than just + generation of warnings. + * sem_ch3.adb (Build_Derived_Type): Do not call + Set_Derived_Type_Link if the derived type and the parent type + are in different compilation units. Such a derivation cannot be + a problematic "early" derivation (identifying these is what the + Derived_Type_Link attribute is used for) and we don't like + inter-unit references that go in the opposite direction of + semantic dependencies. + * sem_ch13.adb (Is_Type_Related_Rep_Item): A new function, + analogous to the existing function Is_Operational_Item. + (Rep_Item_Too_Late): Generate a hard error (with same text as + the warning that was previously being generated) if the + AI12-0109 legality rule is violated. + 2019-12-13 Eric Botcazou * doc/gnat_rm/implementation_defined_pragmas.rst: Minor tweak to diff --git a/gcc/ada/einfo.ads b/gcc/ada/einfo.ads index c178e3a..0aa7e00 100644 --- a/gcc/ada/einfo.ads +++ b/gcc/ada/einfo.ads @@ -929,12 +929,12 @@ package Einfo is -- -- In this case, if primitive operations have been declared for R, at -- the point of declaration of G, then the Derived_Type_Link of R is set --- to point to the entity for G. This is used to generate warnings for --- rep clauses that appear later on for R, which might result in an --- unexpected implicit conversion operation. +-- to point to the entity for G. This is used to generate warnings and +-- errors for rep clauses that appear later on for R, which might result +-- in an unexpected (or illegal) implicit conversion operation. -- -- Note: if there is more than one such derived type, the link will point --- to the last one (this is only used in generating warning messages). +-- to the last one. -- Designated_Type (synthesized) -- Applies to access types. Returns the designated type. Differs from diff --git a/gcc/ada/sem_ch13.adb b/gcc/ada/sem_ch13.adb index 9c8a0cf..b2b9efa 100644 --- a/gcc/ada/sem_ch13.adb +++ b/gcc/ada/sem_ch13.adb @@ -154,6 +154,10 @@ package body Sem_Ch13 is -- that do not specify a representation characteristic are operational -- attributes. + function Is_Type_Related_Rep_Item (N : Node_Id) return Boolean; + -- Returns True for a representation clause/pragma that specifies a + -- type-related representation (as opposed to operational) aspect. + function Is_Predicate_Static (Expr : Node_Id; Nam : Name_Id) return Boolean; @@ -12282,6 +12286,59 @@ package body Sem_Ch13 is end if; end Is_Predicate_Static; + ------------------------------ + -- Is_Type_Related_Rep_Item -- + ------------------------------ + + function Is_Type_Related_Rep_Item (N : Node_Id) return Boolean is + begin + case Nkind (N) is + when N_Attribute_Definition_Clause => + declare + Id : constant Attribute_Id := Get_Attribute_Id (Chars (N)); + -- See AARM 13.1(8.f-8.x) list items that end in "clause" + -- ???: include any GNAT-defined attributes here? + begin + return Id = Attribute_Component_Size + or else Id = Attribute_Bit_Order + or else Id = Attribute_Storage_Pool + or else Id = Attribute_Stream_Size + or else Id = Attribute_Machine_Radix; + end; + + when N_Pragma => + case Get_Pragma_Id (N) is + -- See AARM 13.1(8.f-8.x) list items that start with "pragma" + -- ???: include any GNAT-defined pragmas here? + when Pragma_Pack + | Pragma_Import + | Pragma_Export + | Pragma_Convention + | Pragma_Atomic + | Pragma_Independent + | Pragma_Volatile + | Pragma_Atomic_Components + | Pragma_Independent_Components + | Pragma_Volatile_Components + | Pragma_Discard_Names + => + return True; + when others => + null; + end case; + + when N_Enumeration_Representation_Clause + | N_Record_Representation_Clause + => + return True; + + when others => + null; + end case; + + return False; + end Is_Type_Related_Rep_Item; + --------------------- -- Kill_Rep_Clause -- --------------------- @@ -12964,7 +13021,7 @@ package body Sem_Ch13 is end if; -- No error, but one more warning to consider. The RM (surprisingly) - -- allows this pattern: + -- allows this pattern in some cases: -- type S is ... -- primitive operations for S @@ -12973,7 +13030,7 @@ package body Sem_Ch13 is -- Meaning that calls on the primitive operations of S for values of -- type R may require possibly expensive implicit conversion operations. - -- This is not an error, but is worth a warning. + -- So even when this is not an error, it is still worth a warning. if not Relaxed_RM_Semantics and then Is_Type (T) then declare @@ -12981,26 +13038,47 @@ package body Sem_Ch13 is begin if Present (DTL) - and then Has_Primitive_Operations (Base_Type (T)) - -- For now, do not generate this warning for the case of aspect - -- specification using Ada 2012 syntax, since we get wrong - -- messages we do not understand. The whole business of derived - -- types and rep items seems a bit confused when aspects are - -- used, since the aspects are not evaluated till freeze time. + -- For now, do not generate this warning for the case of + -- aspect specification using Ada 2012 syntax, since we get + -- wrong messages we do not understand. The whole business + -- of derived types and rep items seems a bit confused when + -- aspects are used, since the aspects are not evaluated + -- till freeze time. However, AI12-0109 confirms (in an AARM + -- ramification) that inheritance in this case is required + -- to work. and then not From_Aspect_Specification (N) then - Error_Msg_Sloc := Sloc (DTL); - Error_Msg_N - ("representation item for& appears after derived type " - & "declaration#??", N); - Error_Msg_NE - ("\may result in implicit conversions for primitive " - & "operations of&??", N, T); - Error_Msg_NE - ("\to change representations when called with arguments " - & "of type&??", N, DTL); + if Is_By_Reference_Type (T) + and then not Is_Tagged_Type (T) + and then Is_Type_Related_Rep_Item (N) + and then (Ada_Version >= Ada_2012 + or else Has_Primitive_Operations (Base_Type (T))) + then + -- Treat as hard error (AI12-0109, binding interpretation). + -- Implementing a change of representation is not really + -- an option in the case of a by-reference type, so we + -- take this path for all Ada dialects if primitive + -- operations are present. + Error_Msg_Sloc := Sloc (DTL); + Error_Msg_N + ("representation item for& appears after derived type " + & "declaration#", N); + + elsif Has_Primitive_Operations (Base_Type (T)) then + Error_Msg_Sloc := Sloc (DTL); + + Error_Msg_N + ("representation item for& appears after derived type " + & "declaration#??", N); + Error_Msg_NE + ("\may result in implicit conversions for primitive " + & "operations of&??", N, T); + Error_Msg_NE + ("\to change representations when called with arguments " + & "of type&??", N, DTL); + end if; end if; end; end if; diff --git a/gcc/ada/sem_ch3.adb b/gcc/ada/sem_ch3.adb index c3b8796..9554c33 100644 --- a/gcc/ada/sem_ch3.adb +++ b/gcc/ada/sem_ch3.adb @@ -9741,9 +9741,17 @@ package body Sem_Ch3 is (Derived_Type, No_Tagged_Streams_Pragma (Parent_Type)); end if; - -- If the parent has primitive routines, set the derived type link - - if Has_Primitive_Operations (Parent_Type) then + -- If the parent has primitive routines and may have not-seen-yet aspect + -- specifications (e.g., a Pack pragma), then set the derived type link + -- in order to later diagnose "early derivation" issues. If in different + -- compilation units, then "early derivation" cannot be an issue (and we + -- don't like interunit references that go in the opposite direction of + -- semantic dependencies). + + if Has_Primitive_Operations (Parent_Type) + and then Enclosing_Comp_Unit_Node (Parent_Type) = + Enclosing_Comp_Unit_Node (Derived_Type) + then Set_Derived_Type_Link (Parent_Base, Derived_Type); end if; -- cgit v1.1 From 02458cc74236718edd74f3d4bd6cc259ebbba5ca Mon Sep 17 00:00:00 2001 From: Javier Miranda Date: Fri, 13 Dec 2019 09:04:43 +0000 Subject: [Ada] Adding support for unsupported type conversion in CCG 2019-12-13 Javier Miranda gcc/ada/ * exp_ch4.adb (Expand_N_Unchecked_Type_Conversion): Generate an extra temporary for cases unsupported by the C backend. From-SVN: r279356 --- gcc/ada/ChangeLog | 5 +++++ gcc/ada/exp_ch4.adb | 21 +++++++++++++++++++++ 2 files changed, 26 insertions(+) (limited to 'gcc/ada') diff --git a/gcc/ada/ChangeLog b/gcc/ada/ChangeLog index 69176db..dde5372 100644 --- a/gcc/ada/ChangeLog +++ b/gcc/ada/ChangeLog @@ -1,3 +1,8 @@ +2019-12-13 Javier Miranda + + * exp_ch4.adb (Expand_N_Unchecked_Type_Conversion): Generate an + extra temporary for cases unsupported by the C backend. + 2019-12-13 Steve Baird * einfo.ads: Correct comment for Derived_Type_Link to reflect diff --git a/gcc/ada/exp_ch4.adb b/gcc/ada/exp_ch4.adb index 1955823..28d48ab 100644 --- a/gcc/ada/exp_ch4.adb +++ b/gcc/ada/exp_ch4.adb @@ -12471,6 +12471,27 @@ package body Exp_Ch4 is end; end if; + -- Generate an extra temporary for cases unsupported by the C backend + + if Modify_Tree_For_C then + declare + Source : constant Node_Id := Unqual_Conv (Expression (N)); + Source_Typ : Entity_Id := Get_Full_View (Etype (Source)); + + begin + if Is_Packed_Array (Source_Typ) then + Source_Typ := Packed_Array_Impl_Type (Source_Typ); + end if; + + if Nkind (Source) = N_Function_Call + and then (Is_Composite_Type (Etype (Source)) + or else Is_Composite_Type (Target_Type)) + then + Force_Evaluation (Source); + end if; + end; + end if; + -- Nothing to do if conversion is safe if Safe_Unchecked_Type_Conversion (N) then -- cgit v1.1 From a85475beae62f908312ddb233d79cf1df60216e5 Mon Sep 17 00:00:00 2001 From: Steve Baird Date: Fri, 13 Dec 2019 09:04:48 +0000 Subject: [Ada] Detect illegal implicit type conversions 2019-12-13 Steve Baird gcc/ada/ * sem_res.adb (Resolve, Valid_Conversion): Add Base_Type call when testing whether a type is a general access type. From-SVN: r279357 --- gcc/ada/ChangeLog | 5 +++++ gcc/ada/sem_res.adb | 4 ++-- 2 files changed, 7 insertions(+), 2 deletions(-) (limited to 'gcc/ada') diff --git a/gcc/ada/ChangeLog b/gcc/ada/ChangeLog index dde5372..c920c2c 100644 --- a/gcc/ada/ChangeLog +++ b/gcc/ada/ChangeLog @@ -1,3 +1,8 @@ +2019-12-13 Steve Baird + + * sem_res.adb (Resolve, Valid_Conversion): Add Base_Type call + when testing whether a type is a general access type. + 2019-12-13 Javier Miranda * exp_ch4.adb (Expand_N_Unchecked_Type_Conversion): Generate an diff --git a/gcc/ada/sem_res.adb b/gcc/ada/sem_res.adb index 3568a89..54d4728 100644 --- a/gcc/ada/sem_res.adb +++ b/gcc/ada/sem_res.adb @@ -3256,7 +3256,7 @@ package body Sem_Res is -- convert implicitly are allowed in membership tests). if Ada_Version >= Ada_2012 - and then Ekind (Ctx_Type) = E_General_Access_Type + and then Ekind (Base_Type (Ctx_Type)) = E_General_Access_Type and then Ekind (Etype (N)) = E_Anonymous_Access_Type and then Nkind (Parent (N)) not in N_Membership_Test then @@ -13328,7 +13328,7 @@ package body Sem_Res is if Ada_Version >= Ada_2012 and then not Comes_From_Source (N) and then Is_Rewrite_Substitution (N) - and then Ekind (Target_Type) = E_General_Access_Type + and then Ekind (Base_Type (Target_Type)) = E_General_Access_Type and then Ekind (Opnd_Type) = E_Anonymous_Access_Type then if Is_Itype (Opnd_Type) then -- cgit v1.1 From 8973b987b6e8a33560a20723d2d32275ee86e907 Mon Sep 17 00:00:00 2001 From: Piotr Trojanek Date: Fri, 13 Dec 2019 09:04:53 +0000 Subject: [Ada] Minor fix typo in comment 2019-12-13 Piotr Trojanek gcc/ada/ * exp_aggr.adb, exp_unst.adb: Minor fix typo in comment. From-SVN: r279358 --- gcc/ada/ChangeLog | 4 ++++ gcc/ada/exp_aggr.adb | 2 +- gcc/ada/exp_unst.adb | 2 +- 3 files changed, 6 insertions(+), 2 deletions(-) (limited to 'gcc/ada') diff --git a/gcc/ada/ChangeLog b/gcc/ada/ChangeLog index c920c2c..9af0c43 100644 --- a/gcc/ada/ChangeLog +++ b/gcc/ada/ChangeLog @@ -1,3 +1,7 @@ +2019-12-13 Piotr Trojanek + + * exp_aggr.adb, exp_unst.adb: Minor fix typo in comment. + 2019-12-13 Steve Baird * sem_res.adb (Resolve, Valid_Conversion): Add Base_Type call diff --git a/gcc/ada/exp_aggr.adb b/gcc/ada/exp_aggr.adb index 3d3dd1b..60ad4d6 100644 --- a/gcc/ada/exp_aggr.adb +++ b/gcc/ada/exp_aggr.adb @@ -7499,7 +7499,7 @@ package body Exp_Aggr is return; end if; - -- If the pramga Aggregate_Individually_Assign is set, always convert to + -- If the pragma Aggregate_Individually_Assign is set, always convert to -- assignments. if Aggregate_Individually_Assign then diff --git a/gcc/ada/exp_unst.adb b/gcc/ada/exp_unst.adb index 6c1eb4b..5347a7f 100644 --- a/gcc/ada/exp_unst.adb +++ b/gcc/ada/exp_unst.adb @@ -1801,7 +1801,7 @@ package body Exp_Unst is Comp : Entity_Id; Decl_Assign : Node_Id; - -- Assigment to set uplink, Empty if none + -- Assignment to set uplink, Empty if none Decl_ARECnT : Node_Id; Decl_ARECnPT : Node_Id; -- cgit v1.1 From de12d07e93ca47cacbbeda1107e7cc3b6af9ad63 Mon Sep 17 00:00:00 2001 From: Yannick Moy Date: Fri, 13 Dec 2019 09:04:58 +0000 Subject: [Ada] Avoid spurious mismatch error of assertion policy in generics 2019-12-13 Yannick Moy gcc/ada/ * sem_util.adb (Original_Aspect_Pragma_Name): Go through Original_Node for pragma. From-SVN: r279359 --- gcc/ada/ChangeLog | 5 +++++ gcc/ada/sem_util.adb | 9 ++++++--- 2 files changed, 11 insertions(+), 3 deletions(-) (limited to 'gcc/ada') diff --git a/gcc/ada/ChangeLog b/gcc/ada/ChangeLog index 9af0c43..3ec76a2 100644 --- a/gcc/ada/ChangeLog +++ b/gcc/ada/ChangeLog @@ -1,3 +1,8 @@ +2019-12-13 Yannick Moy + + * sem_util.adb (Original_Aspect_Pragma_Name): Go through + Original_Node for pragma. + 2019-12-13 Piotr Trojanek * exp_aggr.adb, exp_unst.adb: Minor fix typo in comment. diff --git a/gcc/ada/sem_util.adb b/gcc/ada/sem_util.adb index 03ce7c0..e29360f 100644 --- a/gcc/ada/sem_util.adb +++ b/gcc/ada/sem_util.adb @@ -23326,13 +23326,16 @@ package body Sem_Util is Item := Corresponding_Aspect (Item); end if; - -- Retrieve the name of the aspect/pragma. Note that Pre, Pre_Class, + -- Retrieve the name of the aspect/pragma. As assertion pragmas from + -- a generic instantiation might have been rewritten into pragma Check, + -- we look at the original node for Item. Note also that Pre, Pre_Class, -- Post and Post_Class rewrite their pragma identifier to preserve the - -- original name. + -- original name, so we look at the original node for the identifier. -- ??? this is kludgey if Nkind (Item) = N_Pragma then - Item_Nam := Chars (Original_Node (Pragma_Identifier (Item))); + Item_Nam := + Chars (Original_Node (Pragma_Identifier (Original_Node (Item)))); else pragma Assert (Nkind (Item) = N_Aspect_Specification); -- cgit v1.1 From 48f05f09e6791abe2080466f968c2cc27c401028 Mon Sep 17 00:00:00 2001 From: Javier Miranda Date: Fri, 13 Dec 2019 09:05:03 +0000 Subject: [Ada] Pragma Linker_Section in subprogram instantiations in CCG 2019-12-13 Javier Miranda gcc/ada/ * sem_prag.adb (Analyze_Pragma): Propagate the Linker_Section_Attribute to the ultimate alias of the subprogram to facilitate the C backend processing this attribute. From-SVN: r279360 --- gcc/ada/ChangeLog | 6 ++++++ gcc/ada/sem_prag.adb | 20 ++++++++++++++++++++ 2 files changed, 26 insertions(+) (limited to 'gcc/ada') diff --git a/gcc/ada/ChangeLog b/gcc/ada/ChangeLog index 3ec76a2..d135da8 100644 --- a/gcc/ada/ChangeLog +++ b/gcc/ada/ChangeLog @@ -1,3 +1,9 @@ +2019-12-13 Javier Miranda + + * sem_prag.adb (Analyze_Pragma): Propagate the + Linker_Section_Attribute to the ultimate alias of the subprogram + to facilitate the C backend processing this attribute. + 2019-12-13 Yannick Moy * sem_util.adb (Original_Aspect_Pragma_Name): Go through diff --git a/gcc/ada/sem_prag.adb b/gcc/ada/sem_prag.adb index d1d4747..db4b1b4 100644 --- a/gcc/ada/sem_prag.adb +++ b/gcc/ada/sem_prag.adb @@ -19188,6 +19188,17 @@ package body Sem_Prag is Set_Linker_Section_Pragma (Entity (Corresponding_Aspect (N)), N); + -- Propagate it to its ultimate aliased entity to + -- facilitate the backend processing this attribute + -- in instantiations of generic subprograms. + + if Present (Alias (Entity (Corresponding_Aspect (N)))) + then + Set_Linker_Section_Pragma + (Ultimate_Alias + (Entity (Corresponding_Aspect (N))), N); + end if; + -- Pragma case, we must climb the homonym chain, but skip -- any for which the linker section is already set. @@ -19196,6 +19207,15 @@ package body Sem_Prag is if No (Linker_Section_Pragma (Ent)) then Set_Linker_Section_Pragma (Ent, N); + -- Propagate it to its ultimate aliased entity to + -- facilitate the backend processing this attribute + -- in instantiations of generic subprograms. + + if Present (Alias (Ent)) then + Set_Linker_Section_Pragma + (Ultimate_Alias (Ent), N); + end if; + -- A pragma that applies to a Ghost entity becomes -- Ghost for the purposes of legality checks and -- removal of ignored Ghost code. -- cgit v1.1 From 3af796b550ebadbdba31dccea948b52fad7287dc Mon Sep 17 00:00:00 2001 From: Javier Miranda Date: Fri, 13 Dec 2019 09:05:08 +0000 Subject: [Ada] Adding support for unsupported type conversions in CCG 2019-12-13 Javier Miranda gcc/ada/ * exp_unst.adb (Unnest_Subprogram): Generate an extra temporary to facilitate the C backend processing dereferences. From-SVN: r279361 --- gcc/ada/ChangeLog | 5 +++++ gcc/ada/exp_unst.adb | 13 +++++++++++++ 2 files changed, 18 insertions(+) (limited to 'gcc/ada') diff --git a/gcc/ada/ChangeLog b/gcc/ada/ChangeLog index d135da8..0f58e09 100644 --- a/gcc/ada/ChangeLog +++ b/gcc/ada/ChangeLog @@ -1,5 +1,10 @@ 2019-12-13 Javier Miranda + * exp_unst.adb (Unnest_Subprogram): Generate an extra temporary + to facilitate the C backend processing dereferences. + +2019-12-13 Javier Miranda + * sem_prag.adb (Analyze_Pragma): Propagate the Linker_Section_Attribute to the ultimate alias of the subprogram to facilitate the C backend processing this attribute. diff --git a/gcc/ada/exp_unst.adb b/gcc/ada/exp_unst.adb index 5347a7f..f016d2f 100644 --- a/gcc/ada/exp_unst.adb +++ b/gcc/ada/exp_unst.adb @@ -27,6 +27,7 @@ with Atree; use Atree; with Debug; use Debug; with Einfo; use Einfo; with Elists; use Elists; +with Exp_Util; use Exp_Util; with Lib; use Lib; with Namet; use Namet; with Nlists; use Nlists; @@ -2345,6 +2346,18 @@ package body Exp_Unst is -- expect any exceptions) Analyze_And_Resolve (UPJ.Ref, Typ, Suppress => All_Checks); + + -- Generate an extra temporary to facilitate the C backend + -- processing this dereference + + if Opt.Modify_Tree_For_C + and then Nkind_In (Parent (UPJ.Ref), + N_Type_Conversion, + N_Unchecked_Type_Conversion) + then + Force_Evaluation (UPJ.Ref, Mode => Strict); + end if; + Pop_Scope; end Rewrite_One_Ref; end; -- cgit v1.1 From 309ff6fb2332471dbe0e5ee692ea88b0a7dc1c94 Mon Sep 17 00:00:00 2001 From: Arnaud Charlet Date: Fri, 13 Dec 2019 09:05:13 +0000 Subject: [Ada] Fix support for > 24 hours image in Ada.Calendar.Formatting 2019-12-13 Arnaud Charlet gcc/ada/ * libgnat/a-calfor.ads, libgnat/a-calfor.adb (Split_Duration): New procedure. (Split, Image): Use Split_Duration. Update Image spec. From-SVN: r279362 --- gcc/ada/ChangeLog | 6 +++++ gcc/ada/libgnat/a-calfor.adb | 62 +++++++++++++++++++++++++++++++------------- gcc/ada/libgnat/a-calfor.ads | 2 +- 3 files changed, 51 insertions(+), 19 deletions(-) (limited to 'gcc/ada') diff --git a/gcc/ada/ChangeLog b/gcc/ada/ChangeLog index 0f58e09..9f49f86 100644 --- a/gcc/ada/ChangeLog +++ b/gcc/ada/ChangeLog @@ -1,3 +1,9 @@ +2019-12-13 Arnaud Charlet + + * libgnat/a-calfor.ads, libgnat/a-calfor.adb (Split_Duration): + New procedure. + (Split, Image): Use Split_Duration. Update Image spec. + 2019-12-13 Javier Miranda * exp_unst.adb (Unnest_Subprogram): Generate an extra temporary diff --git a/gcc/ada/libgnat/a-calfor.adb b/gcc/ada/libgnat/a-calfor.adb index 0fbb1ab..5cc151d 100644 --- a/gcc/ada/libgnat/a-calfor.adb +++ b/gcc/ada/libgnat/a-calfor.adb @@ -52,6 +52,15 @@ package body Ada.Calendar.Formatting is -- such as 1983-*1-j3 u5:n7:k9 which should be 1983-01-03 05:07:09. Raise -- Constraint_Error if there is a mismatch. + procedure Split_Duration + (Seconds : Duration; + Hour : out Natural; + Minute : out Minute_Number; + Second : out Second_Number; + Sub_Second : out Second_Duration); + -- Version of Split that allows durations < 100 hours. + -- Will raise Time_Error if Seconds >= 100 hours. + ---------------- -- Check_Char -- ---------------- @@ -140,7 +149,7 @@ package body Ada.Calendar.Formatting is Include_Time_Fraction : Boolean := False) return String is To_Char : constant array (0 .. 9) of Character := "0123456789"; - Hour : Hour_Number; + Hour : Natural; Minute : Minute_Number; Second : Second_Number; Sub_Second : Duration; @@ -155,7 +164,7 @@ package body Ada.Calendar.Formatting is Result : String := "-00:00:00.00"; begin - Split (abs (Elapsed_Time), Hour, Minute, Second, Sub_Second); + Split_Duration (abs Elapsed_Time, Hour, Minute, Second, Sub_Second); -- Hour processing, positions 2 and 3 @@ -361,6 +370,34 @@ package body Ada.Calendar.Formatting is Sub_Second; end Seconds_Of; + -------------------- + -- Split_Duration -- + -------------------- + + procedure Split_Duration + (Seconds : Duration; + Hour : out Natural; + Minute : out Minute_Number; + Second : out Second_Number; + Sub_Second : out Second_Duration) + is + Secs : Natural; + begin + -- Check that Seconds is below 100 hours + + if Seconds >= 3600.0 * 100.0 then + raise Time_Error; + end if; + + Secs := (if Seconds = 0.0 then 0 else Natural (Seconds - 0.5)); + + Sub_Second := Second_Duration (Seconds - Duration (Secs)); + Hour := Natural (Secs / 3_600); + Secs := Secs mod 3_600; + Minute := Minute_Number (Secs / 60); + Second := Second_Number (Secs mod 60); + end Split_Duration; + ----------- -- Split -- ----------- @@ -372,8 +409,7 @@ package body Ada.Calendar.Formatting is Second : out Second_Number; Sub_Second : out Second_Duration) is - Secs : Natural; - + Unchecked_Hour : Natural; begin -- Validity checks @@ -381,23 +417,13 @@ package body Ada.Calendar.Formatting is raise Constraint_Error; end if; - Secs := (if Seconds = 0.0 then 0 else Natural (Seconds - 0.5)); - - Sub_Second := Second_Duration (Seconds - Day_Duration (Secs)); - Hour := Hour_Number (Secs / 3_600); - Secs := Secs mod 3_600; - Minute := Minute_Number (Secs / 60); - Second := Second_Number (Secs mod 60); - - -- Validity checks + Split_Duration (Seconds, Unchecked_Hour, Minute, Second, Sub_Second); - if not Hour'Valid - or else not Minute'Valid - or else not Second'Valid - or else not Sub_Second'Valid - then + if Unchecked_Hour > Hour_Number'Last then raise Time_Error; end if; + + Hour := Unchecked_Hour; end Split; ----------- diff --git a/gcc/ada/libgnat/a-calfor.ads b/gcc/ada/libgnat/a-calfor.ads index 78603ea..60a586e 100644 --- a/gcc/ada/libgnat/a-calfor.ads +++ b/gcc/ada/libgnat/a-calfor.ads @@ -204,7 +204,7 @@ package Ada.Calendar.Formatting is -- to the string as a point followed by a 2-digit value. If Elapsed_Time < -- 0.0, the result is Image (abs Elapsed_Time, Include_Time_Fraction) -- prefixed with a minus sign. If abs Elapsed_Time represents 100 hours or - -- more, the result is implementation-defined. + -- more, Time_Error is raised. function Value (Elapsed_Time : String) return Duration; -- Returns a Duration value for the image given as Elapsed_Time. -- cgit v1.1 From a35c1b077e32e4b552dd1d0f2385a3885fcabf4b Mon Sep 17 00:00:00 2001 From: Eric Botcazou Date: Fri, 13 Dec 2019 09:05:18 +0000 Subject: [Ada] Clear confusion about subcomponents of atomic object 2019-12-13 Eric Botcazou gcc/ada/ * sem_util.ads (Is_Atomic_Object): Mention relevant RM clauses. * sem_util.adb (Is_Atomic_Object): For an indexed component, only look at the Has_Atomic_Components aspect of the prefix and do not recurse on it; for a selected component, do not look at the prefix. (Is_Atomic_Or_VFA_Object): Minor tweak. From-SVN: r279363 --- gcc/ada/ChangeLog | 9 +++++++++ gcc/ada/sem_util.adb | 52 ++++++++++++++++------------------------------------ gcc/ada/sem_util.ads | 2 +- 3 files changed, 26 insertions(+), 37 deletions(-) (limited to 'gcc/ada') diff --git a/gcc/ada/ChangeLog b/gcc/ada/ChangeLog index 9f49f86..a1f971a 100644 --- a/gcc/ada/ChangeLog +++ b/gcc/ada/ChangeLog @@ -1,3 +1,12 @@ +2019-12-13 Eric Botcazou + + * sem_util.ads (Is_Atomic_Object): Mention relevant RM clauses. + * sem_util.adb (Is_Atomic_Object): For an indexed component, + only look at the Has_Atomic_Components aspect of the prefix and + do not recurse on it; for a selected component, do not look at + the prefix. + (Is_Atomic_Or_VFA_Object): Minor tweak. + 2019-12-13 Arnaud Charlet * libgnat/a-calfor.ads, libgnat/a-calfor.adb (Split_Duration): diff --git a/gcc/ada/sem_util.adb b/gcc/ada/sem_util.adb index e29360f..30a2273 100644 --- a/gcc/ada/sem_util.adb +++ b/gcc/ada/sem_util.adb @@ -13724,54 +13724,33 @@ package body Sem_Util is ---------------------- function Is_Atomic_Object (N : Node_Id) return Boolean is - function Is_Atomic_Entity (Id : Entity_Id) return Boolean; - pragma Inline (Is_Atomic_Entity); - -- Determine whether arbitrary entity Id is either atomic or has atomic + function Prefix_Has_Atomic_Components (Pref : Node_Id) return Boolean; + -- Determine whether prefix Pref of an indexed component has atomic -- components. - function Is_Atomic_Prefix (Pref : Node_Id) return Boolean; - -- Determine whether prefix Pref of an indexed or selected component is - -- an atomic object. - - ---------------------- - -- Is_Atomic_Entity -- - ---------------------- - - function Is_Atomic_Entity (Id : Entity_Id) return Boolean is - begin - return Is_Atomic (Id) or else Has_Atomic_Components (Id); - end Is_Atomic_Entity; - - ---------------------- - -- Is_Atomic_Prefix -- - ---------------------- + --------------------------------- + -- Prefix_Has_Atomic_Components -- + --------------------------------- - function Is_Atomic_Prefix (Pref : Node_Id) return Boolean is + function Prefix_Has_Atomic_Components (Pref : Node_Id) return Boolean is Typ : constant Entity_Id := Etype (Pref); begin if Is_Access_Type (Typ) then return Has_Atomic_Components (Designated_Type (Typ)); - elsif Is_Atomic_Entity (Typ) then + elsif Has_Atomic_Components (Typ) then return True; elsif Is_Entity_Name (Pref) - and then Is_Atomic_Entity (Entity (Pref)) + and then Has_Atomic_Components (Entity (Pref)) then return True; - elsif Nkind (Pref) = N_Indexed_Component then - return Is_Atomic_Prefix (Prefix (Pref)); - - elsif Nkind (Pref) = N_Selected_Component then - return - Is_Atomic_Prefix (Prefix (Pref)) - or else Is_Atomic (Entity (Selector_Name (Pref))); + else + return False; end if; - - return False; - end Is_Atomic_Prefix; + end Prefix_Has_Atomic_Components; -- Start of processing for Is_Atomic_Object @@ -13780,12 +13759,13 @@ package body Sem_Util is return Is_Atomic_Object_Entity (Entity (N)); elsif Nkind (N) = N_Indexed_Component then - return Is_Atomic (Etype (N)) or else Is_Atomic_Prefix (Prefix (N)); + return + Is_Atomic (Etype (N)) + or else Prefix_Has_Atomic_Components (Prefix (N)); elsif Nkind (N) = N_Selected_Component then return Is_Atomic (Etype (N)) - or else Is_Atomic_Prefix (Prefix (N)) or else Is_Atomic (Entity (Selector_Name (N))); end if; @@ -13810,8 +13790,8 @@ package body Sem_Util is function Is_Atomic_Or_VFA_Object (N : Node_Id) return Boolean is begin return Is_Atomic_Object (N) - or else (Is_Object_Reference (N) - and then Is_Entity_Name (N) + or else (Is_Entity_Name (N) + and then Is_Object (Entity (N)) and then (Is_Volatile_Full_Access (Entity (N)) or else Is_Volatile_Full_Access (Etype (Entity (N))))); diff --git a/gcc/ada/sem_util.ads b/gcc/ada/sem_util.ads index ea963de..c354d7e 100644 --- a/gcc/ada/sem_util.ads +++ b/gcc/ada/sem_util.ads @@ -1531,7 +1531,7 @@ package Sem_Util is function Is_Atomic_Object (N : Node_Id) return Boolean; -- Determine whether arbitrary node N denotes a reference to an atomic - -- object as per Ada RM C.6(12). + -- object as per Ada RM C.6(7) and the crucial remark in C.6(8). -- WARNING: There is a matching C declaration of this subprogram in fe.h -- cgit v1.1 From e1e1e53a4861f5addee43088de14dadf47892f23 Mon Sep 17 00:00:00 2001 From: Eric Botcazou Date: Fri, 13 Dec 2019 09:05:23 +0000 Subject: [Ada] Better error message for aliased formal and atomic actual 2019-12-13 Eric Botcazou gcc/ada/ * sem_res.adb (Resolve_Actuals): Give canonical error for illegal case of atomic/volatile parameter also if the formal is aliased. From-SVN: r279364 --- gcc/ada/ChangeLog | 6 ++++++ gcc/ada/sem_res.adb | 2 +- 2 files changed, 7 insertions(+), 1 deletion(-) (limited to 'gcc/ada') diff --git a/gcc/ada/ChangeLog b/gcc/ada/ChangeLog index a1f971a..7282db4 100644 --- a/gcc/ada/ChangeLog +++ b/gcc/ada/ChangeLog @@ -1,5 +1,11 @@ 2019-12-13 Eric Botcazou + * sem_res.adb (Resolve_Actuals): Give canonical error for + illegal case of atomic/volatile parameter also if the formal is + aliased. + +2019-12-13 Eric Botcazou + * sem_util.ads (Is_Atomic_Object): Mention relevant RM clauses. * sem_util.adb (Is_Atomic_Object): For an indexed component, only look at the Has_Atomic_Components aspect of the prefix and diff --git a/gcc/ada/sem_res.adb b/gcc/ada/sem_res.adb index 54d4728..1c5ae36 100644 --- a/gcc/ada/sem_res.adb +++ b/gcc/ada/sem_res.adb @@ -4717,7 +4717,7 @@ package body Sem_Res is -- Check bad case of atomic/volatile argument (RM C.6(12)) - if Is_By_Reference_Type (Etype (F)) + if (Is_By_Reference_Type (Etype (F)) or else Is_Aliased (F)) and then Comes_From_Source (N) then if Is_Atomic_Object (A) -- cgit v1.1 From c90e1eca3782b667c081e08dad03aee5b4f16276 Mon Sep 17 00:00:00 2001 From: Javier Miranda Date: Fri, 13 Dec 2019 09:05:28 +0000 Subject: [Ada] Spurious error on precondition of subprogram instantiation 2019-12-13 Javier Miranda gcc/ada/ * sem_ch13.adb (Analyze_Aspect_Specification): Processing a precondition, if the expression is of the form A and then B, do not generate separate Pre/Post aspects for the separate clases when we are processing a generic unit. Required to avoid reporting spurious visibility errors on the instantiations. From-SVN: r279365 --- gcc/ada/ChangeLog | 8 ++++++++ gcc/ada/sem_ch13.adb | 5 ++++- 2 files changed, 12 insertions(+), 1 deletion(-) (limited to 'gcc/ada') diff --git a/gcc/ada/ChangeLog b/gcc/ada/ChangeLog index 7282db4..bfc9be1 100644 --- a/gcc/ada/ChangeLog +++ b/gcc/ada/ChangeLog @@ -1,3 +1,11 @@ +2019-12-13 Javier Miranda + + * sem_ch13.adb (Analyze_Aspect_Specification): Processing a + precondition, if the expression is of the form A and then B, do + not generate separate Pre/Post aspects for the separate clases + when we are processing a generic unit. Required to avoid + reporting spurious visibility errors on the instantiations. + 2019-12-13 Eric Botcazou * sem_res.adb (Resolve_Actuals): Give canonical error for diff --git a/gcc/ada/sem_ch13.adb b/gcc/ada/sem_ch13.adb index b2b9efa..e266af9 100644 --- a/gcc/ada/sem_ch13.adb +++ b/gcc/ada/sem_ch13.adb @@ -3479,11 +3479,14 @@ package body Sem_Ch13 is -- don't do this in GNATprove mode, because it brings no -- benefit for proof and causes annoynace for flow analysis, -- which prefers to be as close to the original source code - -- as possible. + -- as possible. Also we don't do this when analyzing generic + -- units since it causes spurious visibility errors in the + -- preanalysis of instantiations. if not (ASIS_Mode or GNATprove_Mode) and then (Pname = Name_Postcondition or else not Class_Present (Aspect)) + and then not Inside_A_Generic then while Nkind (Expr) = N_And_Then loop Insert_After (Aspect, -- cgit v1.1 From e203dd6e24ebb349128e3a4354e5847a90422c64 Mon Sep 17 00:00:00 2001 From: Ghjuvan Lacambre Date: Fri, 13 Dec 2019 09:05:33 +0000 Subject: [Ada] implementation_defined_pragmas.rst: Update Initialize_Scalars docs 2019-12-13 Ghjuvan Lacambre gcc/ada/ * doc/gnat_rm/implementation_defined_pragmas.rst: Update Initialize_Scalars documentation. * gnat_rm.texi: Regenerate. From-SVN: r279366 --- gcc/ada/ChangeLog | 6 ++++++ gcc/ada/doc/gnat_rm/implementation_defined_pragmas.rst | 6 ++++-- gcc/ada/gnat_rm.texi | 6 ++++-- 3 files changed, 14 insertions(+), 4 deletions(-) (limited to 'gcc/ada') diff --git a/gcc/ada/ChangeLog b/gcc/ada/ChangeLog index bfc9be1..cfa051a 100644 --- a/gcc/ada/ChangeLog +++ b/gcc/ada/ChangeLog @@ -1,3 +1,9 @@ +2019-12-13 Ghjuvan Lacambre + + * doc/gnat_rm/implementation_defined_pragmas.rst: Update + Initialize_Scalars documentation. + * gnat_rm.texi: Regenerate. + 2019-12-13 Javier Miranda * sem_ch13.adb (Analyze_Aspect_Specification): Processing a diff --git a/gcc/ada/doc/gnat_rm/implementation_defined_pragmas.rst b/gcc/ada/doc/gnat_rm/implementation_defined_pragmas.rst index fd66aed..04e4ac8 100644 --- a/gcc/ada/doc/gnat_rm/implementation_defined_pragmas.rst +++ b/gcc/ada/doc/gnat_rm/implementation_defined_pragmas.rst @@ -3057,7 +3057,9 @@ different ways: particular family of scalar types using the optional arguments of the pragma. The compile-time approach is intended to optimize the generated code for the - pragma, by possibly using fast operations such as ``memset``. + pragma, by possibly using fast operations such as ``memset``. Note that such + optimizations require using values the bytes of which all have the same + binary representation. * At bind time, the programmer has several options: @@ -3077,7 +3079,7 @@ different ways: The bind-time approach is intended to provide fast turnaround for testing with different values, without having to recompile the program. -* At execution time, the programmer can speify the invalid values using an +* At execution time, the programmer can specify the invalid values using an environment variable. See the GNAT User's Guide for details. The execution-time approach is intended to provide fast turnaround for diff --git a/gcc/ada/gnat_rm.texi b/gcc/ada/gnat_rm.texi index 8d909de..19c6290 100644 --- a/gcc/ada/gnat_rm.texi +++ b/gcc/ada/gnat_rm.texi @@ -4508,7 +4508,9 @@ At compile time, the programmer can specify the invalid value for a particular family of scalar types using the optional arguments of the pragma. The compile-time approach is intended to optimize the generated code for the -pragma, by possibly using fast operations such as @code{memset}. +pragma, by possibly using fast operations such as @code{memset}. Note that such +optimizations require using values the bytes of which all have the same +binary representation. @item At bind time, the programmer has several options: @@ -4538,7 +4540,7 @@ The bind-time approach is intended to provide fast turnaround for testing with different values, without having to recompile the program. @item -At execution time, the programmer can speify the invalid values using an +At execution time, the programmer can specify the invalid values using an environment variable. See the GNAT User's Guide for details. The execution-time approach is intended to provide fast turnaround for -- cgit v1.1 From 9531aef54f34b65aab0efe92a713d0f825b6cefe Mon Sep 17 00:00:00 2001 From: Arnaud Charlet Date: Fri, 13 Dec 2019 09:05:38 +0000 Subject: [Ada] Unnesting and annex E 2019-12-13 Arnaud Charlet gcc/ada/ * exp_unst.adb (Unnest_Subprogram): Account for trees produced by Annex E constructs. From-SVN: r279367 --- gcc/ada/ChangeLog | 5 +++++ gcc/ada/exp_unst.adb | 7 +++++-- 2 files changed, 10 insertions(+), 2 deletions(-) (limited to 'gcc/ada') diff --git a/gcc/ada/ChangeLog b/gcc/ada/ChangeLog index cfa051a..d48a361 100644 --- a/gcc/ada/ChangeLog +++ b/gcc/ada/ChangeLog @@ -1,3 +1,8 @@ +2019-12-13 Arnaud Charlet + + * exp_unst.adb (Unnest_Subprogram): Account for trees produced + by Annex E constructs. + 2019-12-13 Ghjuvan Lacambre * doc/gnat_rm/implementation_defined_pragmas.rst: Update diff --git a/gcc/ada/exp_unst.adb b/gcc/ada/exp_unst.adb index f016d2f..1747281 100644 --- a/gcc/ada/exp_unst.adb +++ b/gcc/ada/exp_unst.adb @@ -414,11 +414,14 @@ package body Exp_Unst is then return; - -- Only unnest when generating code for the main source unit or if we're - -- unnesting for inline. + -- Only unnest when generating code for the main source unit or if + -- we're unnesting for inline. But in some Annex E cases the Sloc + -- points to a different unit, so also make sure that the Parent + -- isn't in something that we know we're generating code for. elsif not For_Inline and then not In_Extended_Main_Code_Unit (Subp_Body) + and then not In_Extended_Main_Code_Unit (Parent (Subp_Body)) then return; end if; -- cgit v1.1 From 814db0c199fb9c050008f9f1e12534425ccc40c8 Mon Sep 17 00:00:00 2001 From: Gary Dismukes Date: Fri, 13 Dec 2019 09:05:43 +0000 Subject: [Ada] Minor rewording of one sentence 2019-12-13 Gary Dismukes gcc/ada/ * doc/gnat_rm/implementation_defined_pragmas.rst: Minor rewording of one sentence. * gnat_rm.texi: Regenerate. From-SVN: r279368 --- gcc/ada/ChangeLog | 6 ++++++ gcc/ada/doc/gnat_rm/implementation_defined_pragmas.rst | 4 ++-- gcc/ada/gnat_rm.texi | 4 ++-- 3 files changed, 10 insertions(+), 4 deletions(-) (limited to 'gcc/ada') diff --git a/gcc/ada/ChangeLog b/gcc/ada/ChangeLog index d48a361..1fea353 100644 --- a/gcc/ada/ChangeLog +++ b/gcc/ada/ChangeLog @@ -1,3 +1,9 @@ +2019-12-13 Gary Dismukes + + * doc/gnat_rm/implementation_defined_pragmas.rst: Minor + rewording of one sentence. + * gnat_rm.texi: Regenerate. + 2019-12-13 Arnaud Charlet * exp_unst.adb (Unnest_Subprogram): Account for trees produced diff --git a/gcc/ada/doc/gnat_rm/implementation_defined_pragmas.rst b/gcc/ada/doc/gnat_rm/implementation_defined_pragmas.rst index 04e4ac8..6d0bdd8 100644 --- a/gcc/ada/doc/gnat_rm/implementation_defined_pragmas.rst +++ b/gcc/ada/doc/gnat_rm/implementation_defined_pragmas.rst @@ -3058,8 +3058,8 @@ different ways: The compile-time approach is intended to optimize the generated code for the pragma, by possibly using fast operations such as ``memset``. Note that such - optimizations require using values the bytes of which all have the same - binary representation. + optimizations require using values where the bytes all have the same binary + representation. * At bind time, the programmer has several options: diff --git a/gcc/ada/gnat_rm.texi b/gcc/ada/gnat_rm.texi index 19c6290..f7c2923 100644 --- a/gcc/ada/gnat_rm.texi +++ b/gcc/ada/gnat_rm.texi @@ -4509,8 +4509,8 @@ particular family of scalar types using the optional arguments of the pragma. The compile-time approach is intended to optimize the generated code for the pragma, by possibly using fast operations such as @code{memset}. Note that such -optimizations require using values the bytes of which all have the same -binary representation. +optimizations require using values where the bytes all have the same binary +representation. @item At bind time, the programmer has several options: -- cgit v1.1