From fff23f42e89ecee6c86cd08d809437ee90664b5c Mon Sep 17 00:00:00 2001 From: Jakub Jelinek Date: Sat, 10 May 2025 21:20:09 +0200 Subject: fortran: Fix debug info for unsigned(kind=1) and unsigned(kind=4) [PR120193] As the following testcase shows, debug info for unsigned(kind=1) and unsigned(kind=4) vars is wrong while unsigned(kind=2), unsigned(kind=8) and unsigned(kind=16) look right. Instead of objects having unsigned(kind=1) type they have character(kind=1) and instead of unsigned(kind=4) they have character(kind=4). This means in gdb e.g. unsigned(kind=1) :: a(2) variable initialized to 97 will print as 'aa' rather than (97, 97) etc. While there can be just one unsigned_char_type_node and one unsigned_type_node type, each can have arbitrary number of variants (e.g. consider C typedef unsigned char uc; where uc is a variant type to unsigned char) or even distinct types with different TYPE_MAIN_VARIANT. The following patch uses a variant of the character(kind=4) type for unsigned(kind=4) and a distinct type based on character(kind=1) type for unsigned(kind=1). The reason for the latter is that unsigned_char_type_node has TYPE_STRING_FLAG set on it, so it has DW_AT_encoding DW_ATE_unsigned_char rather than DW_ATE_unsigned and so the debugger then likes to print it as characters rather than numbers. That is IMHO in Fortran desirable for character(kind=1) but not for unsigned(kind=1). I've made sure TYPE_CANONICAL of the unsigned(kind=1) type is still character(kind=1), so they are considered compatible by the middle-end also e.g. for aliasing etc. 2025-05-10 Jakub Jelinek PR fortran/120193 * trans-types.cc (gfc_init_types): For flag_unsigned use build_distinct_type_copy or build_variant_type_copy from gfc_character_types[index_char] if index_char > -1 instead of gfc_character_types[index_char] or gfc_build_unsigned_type (&gfc_unsigned_kinds[index]). * gfortran.dg/guality/pr120193.f90: New test. (cherry picked from commit 512371d786e70d27dbaef38d60e9036c11f458c6) --- gcc/fortran/trans-types.cc | 31 ++++++++++++++------------ gcc/testsuite/gfortran.dg/guality/pr120193.f90 | 26 +++++++++++++++++++++ 2 files changed, 43 insertions(+), 14 deletions(-) create mode 100644 gcc/testsuite/gfortran.dg/guality/pr120193.f90 (limited to 'gcc') diff --git a/gcc/fortran/trans-types.cc b/gcc/fortran/trans-types.cc index 3374778..f898075 100644 --- a/gcc/fortran/trans-types.cc +++ b/gcc/fortran/trans-types.cc @@ -1140,11 +1140,6 @@ gfc_init_types (void) } gfc_character1_type_node = gfc_character_types[0]; - /* The middle end only recognizes a single unsigned type. For - compatibility of existing test cases, let's just use the - character type. The reader of tree dumps is expected to be able - to deal with this. */ - if (flag_unsigned) { for (index = 0; gfc_unsigned_kinds[index].kind != 0;++index) @@ -1159,18 +1154,26 @@ gfc_init_types (void) break; } } - if (index_char > 0) + if (index_char > -1) { - gfc_unsigned_types[index] = gfc_character_types[index_char]; + type = gfc_character_types[index_char]; + if (TYPE_STRING_FLAG (type)) + { + type = build_distinct_type_copy (type); + TYPE_CANONICAL (type) + = TYPE_CANONICAL (gfc_character_types[index_char]); + } + else + type = build_variant_type_copy (type); + TYPE_NAME (type) = NULL_TREE; + TYPE_STRING_FLAG (type) = 0; } else - { - type = gfc_build_unsigned_type (&gfc_unsigned_kinds[index]); - gfc_unsigned_types[index] = type; - snprintf (name_buf, sizeof(name_buf), "unsigned(kind=%d)", - gfc_integer_kinds[index].kind); - PUSH_TYPE (name_buf, type); - } + type = gfc_build_unsigned_type (&gfc_unsigned_kinds[index]); + gfc_unsigned_types[index] = type; + snprintf (name_buf, sizeof(name_buf), "unsigned(kind=%d)", + gfc_integer_kinds[index].kind); + PUSH_TYPE (name_buf, type); } } diff --git a/gcc/testsuite/gfortran.dg/guality/pr120193.f90 b/gcc/testsuite/gfortran.dg/guality/pr120193.f90 new file mode 100644 index 0000000..e65febf --- /dev/null +++ b/gcc/testsuite/gfortran.dg/guality/pr120193.f90 @@ -0,0 +1,26 @@ +! PR fortran/120193 +! { dg-do run } +! { dg-options "-g -funsigned" } +! { dg-skip-if "" { *-*-* } { "*" } { "-O0" } } + +program foo + unsigned(kind=1) :: a(2), e + unsigned(kind=2) :: b(2), f + unsigned(kind=4) :: c(2), g + unsigned(kind=8) :: d(2), h + character(kind=1, len=1) :: i(2), j + character(kind=4, len=1) :: k(2), l + a = 97u_1 ! { dg-final { gdb-test 24 "a" "d" } } + b = 97u_2 ! { dg-final { gdb-test 24 "b" "c" } } + c = 97u_4 ! { dg-final { gdb-test 24 "c" "b" } } + d = 97u_8 ! { dg-final { gdb-test 24 "d" "a" } } + e = 97u_1 ! { dg-final { gdb-test 24 "e" "97" } } + f = 97u_2 ! { dg-final { gdb-test 24 "f" "97" } } + g = 97u_4 ! { dg-final { gdb-test 24 "g" "97" } } + h = 97u_8 ! { dg-final { gdb-test 24 "h" "97" } } + i = 'a' ! { dg-final { gdb-test 24 "i" "('a', 'a')" } } + j = 'b' ! { dg-final { gdb-test 24 "j" "'b'" } } + k = 'c' + l = 'd' + print *, a +end program -- cgit v1.1 From c096341a0809b322ece478f67c5d7be6923a0169 Mon Sep 17 00:00:00 2001 From: Jason Merrill Date: Fri, 30 May 2025 18:27:45 -0400 Subject: c++: lambda this capture and requires [PR120123] We shouldn't need to be within the lambda body to look through it to the enclosing non-static member function. This change is a small subset of r16-970. PR c++/120123 gcc/cp/ChangeLog: * lambda.cc (nonlambda_method_basetype): Look through lambdas even when current_class_ref is null. gcc/testsuite/ChangeLog: * g++.dg/cpp2a/concepts-lambda24.C: New test. --- gcc/cp/lambda.cc | 5 +---- gcc/testsuite/g++.dg/cpp2a/concepts-lambda24.C | 13 +++++++++++++ 2 files changed, 14 insertions(+), 4 deletions(-) create mode 100644 gcc/testsuite/g++.dg/cpp2a/concepts-lambda24.C (limited to 'gcc') diff --git a/gcc/cp/lambda.cc b/gcc/cp/lambda.cc index b2e0ecd..352e1b9 100644 --- a/gcc/cp/lambda.cc +++ b/gcc/cp/lambda.cc @@ -1033,12 +1033,9 @@ current_nonlambda_function (void) tree nonlambda_method_basetype (void) { - if (!current_class_ref) - return NULL_TREE; - tree type = current_class_type; if (!type || !LAMBDA_TYPE_P (type)) - return type; + return current_class_ref ? type : NULL_TREE; while (true) { diff --git a/gcc/testsuite/g++.dg/cpp2a/concepts-lambda24.C b/gcc/testsuite/g++.dg/cpp2a/concepts-lambda24.C new file mode 100644 index 0000000..28f56ca --- /dev/null +++ b/gcc/testsuite/g++.dg/cpp2a/concepts-lambda24.C @@ -0,0 +1,13 @@ +// PR c++/120123 +// { dg-do compile { target c++20 } } + +struct H { + void member(int) {} + void call() { + [this]() { + [this](const auto& v) + requires requires { /*this->*/member(v); } + { return member(v); }(0); + }; + } +}; -- cgit v1.1 From 1299fd36ddc3e26309b5194b22d706eef17d0a90 Mon Sep 17 00:00:00 2001 From: GCC Administrator Date: Tue, 3 Jun 2025 00:24:38 +0000 Subject: Daily bump. --- gcc/DATESTAMP | 2 +- gcc/cp/ChangeLog | 6 ++++++ gcc/fortran/ChangeLog | 20 ++++++++++++++++++++ gcc/testsuite/ChangeLog | 32 ++++++++++++++++++++++++++++++++ 4 files changed, 59 insertions(+), 1 deletion(-) (limited to 'gcc') diff --git a/gcc/DATESTAMP b/gcc/DATESTAMP index 5646e6e..42c5479 100644 --- a/gcc/DATESTAMP +++ b/gcc/DATESTAMP @@ -1 +1 @@ -20250602 +20250603 diff --git a/gcc/cp/ChangeLog b/gcc/cp/ChangeLog index 8983abf..2534339 100644 --- a/gcc/cp/ChangeLog +++ b/gcc/cp/ChangeLog @@ -1,3 +1,9 @@ +2025-06-02 Jason Merrill + + PR c++/120123 + * lambda.cc (nonlambda_method_basetype): Look through lambdas + even when current_class_ref is null. + 2025-05-30 Sandra Loosemore Backported from master: diff --git a/gcc/fortran/ChangeLog b/gcc/fortran/ChangeLog index 2f9f5c9..b987938 100644 --- a/gcc/fortran/ChangeLog +++ b/gcc/fortran/ChangeLog @@ -1,3 +1,23 @@ +2025-06-02 Jakub Jelinek + + Backported from master: + 2025-05-10 Jakub Jelinek + + PR fortran/120193 + * trans-types.cc (gfc_init_types): For flag_unsigned use + build_distinct_type_copy or build_variant_type_copy from + gfc_character_types[index_char] if index_char > -1 instead of + gfc_character_types[index_char] or + gfc_build_unsigned_type (&gfc_unsigned_kinds[index]). + +2025-06-02 Jerry DeLisle + + Backported from master: + 2025-05-28 Jerry DeLisle + + PR fortran/119856 + * io.cc: Set missing comma error checks to STD_STD_LEGACY. + 2025-05-31 Jerry DeLisle Backported from master: diff --git a/gcc/testsuite/ChangeLog b/gcc/testsuite/ChangeLog index 5b94c72..73ae83d 100644 --- a/gcc/testsuite/ChangeLog +++ b/gcc/testsuite/ChangeLog @@ -1,3 +1,35 @@ +2025-06-02 Jason Merrill + + PR c++/120123 + * g++.dg/cpp2a/concepts-lambda24.C: New test. + +2025-06-02 Jakub Jelinek + + Backported from master: + 2025-05-10 Jakub Jelinek + + PR fortran/120193 + * gfortran.dg/guality/pr120193.f90: New test. + +2025-06-02 Jerry DeLisle + + Backported from master: + 2025-06-01 Jerry DeLisle + + PR libfortran/119856 + * gfortran.dg/pr119856.f90: New test. + +2025-06-02 Jerry DeLisle + + Backported from master: + 2025-05-28 Jerry DeLisle + + PR fortran/119856 + * gfortran.dg/comma_format_extension_1.f: Update dg-options to + "-std=legacy". + * gfortran.dg/comma_format_extension_3.f: Likewise. + * gfortran.dg/continuation_13.f90: Likewise. + 2025-05-31 Jerry DeLisle Backported from master: -- cgit v1.1 From 25e46423bdfdf6e14cc1bc753f05b3b4fb5e8cc8 Mon Sep 17 00:00:00 2001 From: Harald Anlauf Date: Tue, 27 May 2025 19:23:16 +0200 Subject: Fortran: fix parsing of type parameter inquiries of substrings [PR101735] Handling of type parameter inquiries of substrings failed to due either parsing issues or not following or handling reference chains properly. PR fortran/101735 gcc/fortran/ChangeLog: * expr.cc (find_inquiry_ref): If an inquiry reference applies to a substring, use that, and calculate substring length if needed. * primary.cc (extend_ref): Also handle attaching to end of reference chain for appending. (gfc_match_varspec): Discrimate between arrays of character and substrings of them. If a substring is taken from a character component of a derived type, get the proper typespec so that inquiry references work correctly. (gfc_match_rvalue): Handle corner case where we hit a seemingly dangling '%' and missed an inquiry reference. Try another match. gcc/testsuite/ChangeLog: * gfortran.dg/inquiry_type_ref_7.f90: New test. (cherry picked from commit 787a8dec1acedf5561c8ee43bed0b3653fca150d) --- gcc/fortran/expr.cc | 26 ++++++++++ gcc/fortran/primary.cc | 60 ++++++++++++++++++++--- gcc/testsuite/gfortran.dg/inquiry_type_ref_7.f90 | 62 ++++++++++++++++++++++++ 3 files changed, 142 insertions(+), 6 deletions(-) create mode 100644 gcc/testsuite/gfortran.dg/inquiry_type_ref_7.f90 (limited to 'gcc') diff --git a/gcc/fortran/expr.cc b/gcc/fortran/expr.cc index 827e199..45f59fb 100644 --- a/gcc/fortran/expr.cc +++ b/gcc/fortran/expr.cc @@ -1846,6 +1846,7 @@ find_inquiry_ref (gfc_expr *p, gfc_expr **newp) gfc_ref *ref; gfc_ref *inquiry = NULL; gfc_ref *inquiry_head; + gfc_ref *ref_ss = NULL; gfc_expr *tmp; tmp = gfc_copy_expr (p); @@ -1862,6 +1863,9 @@ find_inquiry_ref (gfc_expr *p, gfc_expr **newp) { inquiry = ref->next; ref->next = NULL; + if (ref->type == REF_SUBSTRING) + ref_ss = ref; + break; } } @@ -1891,6 +1895,28 @@ find_inquiry_ref (gfc_expr *p, gfc_expr **newp) if (!gfc_notify_std (GFC_STD_F2003, "LEN part_ref at %C")) goto cleanup; + /* Inquire length of substring? */ + if (ref_ss) + { + if (ref_ss->u.ss.start->expr_type == EXPR_CONSTANT + && ref_ss->u.ss.end->expr_type == EXPR_CONSTANT) + { + HOST_WIDE_INT istart, iend, length; + istart = gfc_mpz_get_hwi (ref_ss->u.ss.start->value.integer); + iend = gfc_mpz_get_hwi (ref_ss->u.ss.end->value.integer); + + if (istart <= iend) + length = iend - istart + 1; + else + length = 0; + *newp = gfc_get_int_expr (gfc_default_integer_kind, + NULL, length); + break; + } + else + goto cleanup; + } + if (tmp->ts.u.cl->length && tmp->ts.u.cl->length->expr_type == EXPR_CONSTANT) *newp = gfc_copy_expr (tmp->ts.u.cl->length); diff --git a/gcc/fortran/primary.cc b/gcc/fortran/primary.cc index 72ecc7c..8443e89 100644 --- a/gcc/fortran/primary.cc +++ b/gcc/fortran/primary.cc @@ -2102,10 +2102,18 @@ extend_ref (gfc_expr *primary, gfc_ref *tail) { if (primary->ref == NULL) primary->ref = tail = gfc_get_ref (); + else if (tail == NULL) + { + /* Set tail to end of reference chain. */ + for (gfc_ref *ref = primary->ref; ref; ref = ref->next) + if (ref->next == NULL) + { + tail = ref; + break; + } + } else { - if (tail == NULL) - gfc_internal_error ("extend_ref(): Bad tail"); tail->next = gfc_get_ref (); tail = tail->next; } @@ -2302,9 +2310,22 @@ gfc_match_varspec (gfc_expr *primary, int equiv_flag, bool sub_flag, gfc_array_spec *as; bool coarray_only = sym->attr.codimension && !sym->attr.dimension && sym->ts.type == BT_CHARACTER; + gfc_ref *ref, *strarr = NULL; tail = extend_ref (primary, tail); - tail->type = REF_ARRAY; + if (sym->ts.type == BT_CHARACTER && tail->type == REF_SUBSTRING) + { + gcc_assert (sym->attr.dimension); + /* Find array reference for substrings of character arrays. */ + for (ref = primary->ref; ref && ref->next; ref = ref->next) + if (ref->type == REF_ARRAY && ref->next->type == REF_SUBSTRING) + { + strarr = ref; + break; + } + } + else + tail->type = REF_ARRAY; /* In EQUIVALENCE, we don't know yet whether we are seeing an array, character variable or array of character @@ -2317,7 +2338,8 @@ gfc_match_varspec (gfc_expr *primary, int equiv_flag, bool sub_flag, else as = sym->as; - m = gfc_match_array_ref (&tail->u.ar, as, equiv_flag, as ? as->corank : 0, + ref = strarr ? strarr : tail; + m = gfc_match_array_ref (&ref->u.ar, as, equiv_flag, as ? as->corank : 0, coarray_only); if (m != MATCH_YES) return m; @@ -2483,6 +2505,7 @@ gfc_match_varspec (gfc_expr *primary, int equiv_flag, bool sub_flag, { bool t; gfc_symtree *tbp; + gfc_typespec *ts = &primary->ts; m = gfc_match_name (name); if (m == MATCH_NO) @@ -2490,8 +2513,18 @@ gfc_match_varspec (gfc_expr *primary, int equiv_flag, bool sub_flag, if (m != MATCH_YES) return MATCH_ERROR; + /* For derived type components find typespec of ultimate component. */ + if (ts->type == BT_DERIVED && primary->ref) + { + for (gfc_ref *ref = primary->ref; ref; ref = ref->next) + { + if (ref->type == REF_COMPONENT && ref->u.c.component) + ts = &ref->u.c.component->ts; + } + } + intrinsic = false; - if (primary->ts.type != BT_CLASS && primary->ts.type != BT_DERIVED) + if (ts->type != BT_CLASS && ts->type != BT_DERIVED) { inquiry = is_inquiry_ref (name, &tmp); if (inquiry) @@ -2564,7 +2597,7 @@ gfc_match_varspec (gfc_expr *primary, int equiv_flag, bool sub_flag, return MATCH_ERROR; } else if (tmp->u.i == INQUIRY_LEN - && primary->ts.type != BT_CHARACTER) + && ts->type != BT_CHARACTER) { gfc_error ("The LEN part_ref at %C must be applied " "to a CHARACTER expression"); @@ -2653,6 +2686,10 @@ gfc_match_varspec (gfc_expr *primary, int equiv_flag, bool sub_flag, else if (component == NULL && !inquiry) return MATCH_ERROR; + /* Find end of reference chain if inquiry reference and tail not set. */ + if (tail == NULL && inquiry && tmp) + tail = extend_ref (primary, tail); + /* Extend the reference chain determined by gfc_find_component or is_inquiry_ref. */ if (primary->ref == NULL) @@ -2828,6 +2865,7 @@ check_substring: if (substring) primary->ts.u.cl = NULL; + gfc_gobble_whitespace (); if (gfc_peek_ascii_char () == '(') { gfc_error_now ("Unexpected array/substring ref at %C"); @@ -4271,6 +4309,16 @@ gfc_match_rvalue (gfc_expr **result) return MATCH_ERROR; } + /* Scan for possible inquiry references. */ + if (m == MATCH_YES + && e->expr_type == EXPR_VARIABLE + && gfc_peek_ascii_char () == '%') + { + m = gfc_match_varspec (e, 0, false, false); + if (m == MATCH_NO) + m = MATCH_YES; + } + if (m == MATCH_YES) { e->where = where; diff --git a/gcc/testsuite/gfortran.dg/inquiry_type_ref_7.f90 b/gcc/testsuite/gfortran.dg/inquiry_type_ref_7.f90 new file mode 100644 index 0000000..534225a --- /dev/null +++ b/gcc/testsuite/gfortran.dg/inquiry_type_ref_7.f90 @@ -0,0 +1,62 @@ +! { dg-do compile } +! { dg-additional-options "-fdump-tree-original" } +! +! PR fortran/101735 - substrings and parsing of type parameter inquiries + +program p + implicit none + integer, parameter :: ck = 4 + character(len=5) :: str = "" + character(len=5) :: str2(4) + character(len=5,kind=ck) :: str4 = ck_"" + type t + character(len=5) :: str(4) + end type t + type(t) :: var + integer :: x, y + + integer, parameter :: i1 = kind (str(1:3)) + integer, parameter :: j1 = str (1:3) % kind + integer, parameter :: k1 = (str(1:3) % kind) + integer, parameter :: kk = str (1:3) % kind % kind + + integer, parameter :: i4 = kind (str4(1:3)) + integer, parameter :: j4 = str4 (1:3) % kind + integer, parameter :: ll = str4 (1:3) % len + + integer, parameter :: i2 = len (str(1:3)) + integer, parameter :: j2 = str (1:3) % len + integer, parameter :: k2 = (str(1:3) % len) + integer, parameter :: lk = str (1:3) % len % kind + + integer, parameter :: l4 = str2 (:) (2:3) % len + integer, parameter :: l5 = var % str (:) (2:4) % len + integer, parameter :: k4 = str2 (:) (2:3) % kind + integer, parameter :: k5 = var % str (:) (2:4) % kind + integer, parameter :: k6 = str2 (:) (2:3) % len % kind + integer, parameter :: k7 = var % str (:) (2:4) % len % kind + + if (i1 /= 1) stop 1 + if (j1 /= 1) stop 2 + if (k1 /= 1) stop 3 + + if (i4 /= ck) stop 4 + if (j4 /= ck) stop 5 + if (ll /= 3) stop 6 + + if (kk /= 4) stop 7 + if (lk /= 4) stop 8 + + if (i2 /= 3) stop 9 + if (j2 /= 3) stop 10 + if (k2 /= 3) stop 11 + + if (l4 /= 2) stop 12 + if (l5 /= 3) stop 13 + if (k4 /= 1) stop 14 + if (k5 /= 1) stop 15 + if (k6 /= 4) stop 16 + if (k7 /= 4) stop 17 +end + +! { dg-final { scan-tree-dump-not "_gfortran_stop_numeric" "original" } } -- cgit v1.1 From 819b6415b639710566e4cc535241d82ccd708f76 Mon Sep 17 00:00:00 2001 From: Harald Anlauf Date: Tue, 27 May 2025 23:08:54 +0200 Subject: Fortran: fix regression introduced by commit r16-914-g787a8dec1acedf A last-minute cleanup before patch submission reordered a change that should not have happened. This fixes it. PR fortran/101735 gcc/fortran/ChangeLog: * primary.cc (gfc_match_varspec): Correct order of logic. (cherry picked from commit 74a2281ae18c6dbbc640f0c79f7138a495ef8f0c) --- gcc/fortran/primary.cc | 9 +++++---- 1 file changed, 5 insertions(+), 4 deletions(-) (limited to 'gcc') diff --git a/gcc/fortran/primary.cc b/gcc/fortran/primary.cc index 8443e89..794c4b3 100644 --- a/gcc/fortran/primary.cc +++ b/gcc/fortran/primary.cc @@ -2686,16 +2686,17 @@ gfc_match_varspec (gfc_expr *primary, int equiv_flag, bool sub_flag, else if (component == NULL && !inquiry) return MATCH_ERROR; - /* Find end of reference chain if inquiry reference and tail not set. */ - if (tail == NULL && inquiry && tmp) - tail = extend_ref (primary, tail); - /* Extend the reference chain determined by gfc_find_component or is_inquiry_ref. */ if (primary->ref == NULL) primary->ref = tmp; else { + /* Find end of reference chain if inquiry reference and tail not + set. */ + if (tail == NULL && inquiry && tmp) + tail = extend_ref (primary, tail); + /* Set by the for loop below for the last component ref. */ gcc_assert (tail != NULL); tail->next = tmp; -- cgit v1.1 From e8a36b051587dccfc7c161ed4fb42c493212c71f Mon Sep 17 00:00:00 2001 From: Harald Anlauf Date: Fri, 30 May 2025 19:25:15 +0200 Subject: Fortran: parameter inquiries of constant complex arrays [PR102599,PR114022] PR fortran/102599 PR fortran/114022 gcc/fortran/ChangeLog: * expr.cc (simplify_complex_array_inquiry_ref): Helper function for simplification of inquiry references (%re/%im) of constant complex arrays. (find_inquiry_ref): Use it for handling %re/%im inquiry references of complex arrays. (scalarize_intrinsic_call): Fix frontend memleak. * primary.cc (gfc_match_varspec): When the reference is NULL, the previous simplification has succeeded in evaluating inquiry references also of arrays. gcc/testsuite/ChangeLog: * gfortran.dg/inquiry_type_ref_8.f90: New test. (cherry picked from commit 490072b927dac2f57e541b0ee680896e23c5d998) --- gcc/fortran/expr.cc | 84 ++++++++- gcc/fortran/primary.cc | 3 + gcc/testsuite/gfortran.dg/inquiry_type_ref_8.f90 | 214 +++++++++++++++++++++++ 3 files changed, 297 insertions(+), 4 deletions(-) create mode 100644 gcc/testsuite/gfortran.dg/inquiry_type_ref_8.f90 (limited to 'gcc') diff --git a/gcc/fortran/expr.cc b/gcc/fortran/expr.cc index 45f59fb..95ea055 100644 --- a/gcc/fortran/expr.cc +++ b/gcc/fortran/expr.cc @@ -1838,6 +1838,55 @@ find_substring_ref (gfc_expr *p, gfc_expr **newp) } +/* Simplify inquiry references (%re/%im) of constant complex arrays. + Used by find_inquiry_ref. */ + +static gfc_expr * +simplify_complex_array_inquiry_ref (gfc_expr *p, inquiry_type inquiry) +{ + gfc_expr *e, *r, *result; + gfc_constructor_base base; + gfc_constructor *c; + + if ((inquiry != INQUIRY_RE && inquiry != INQUIRY_IM) + || p->expr_type != EXPR_ARRAY + || p->ts.type != BT_COMPLEX + || p->rank <= 0 + || p->value.constructor == NULL + || !gfc_is_constant_array_expr (p)) + return NULL; + + /* Simplify array sections. */ + gfc_simplify_expr (p, 0); + + result = gfc_get_array_expr (BT_REAL, p->ts.kind, &p->where); + result->rank = p->rank; + result->shape = gfc_copy_shape (p->shape, p->rank); + + base = p->value.constructor; + for (c = gfc_constructor_first (base); c; c = gfc_constructor_next (c)) + { + e = c->expr; + if (e->expr_type != EXPR_CONSTANT) + goto fail; + + r = gfc_get_constant_expr (BT_REAL, e->ts.kind, &e->where); + if (inquiry == INQUIRY_RE) + mpfr_set (r->value.real, mpc_realref (e->value.complex), GFC_RND_MODE); + else + mpfr_set (r->value.real, mpc_imagref (e->value.complex), GFC_RND_MODE); + + gfc_constructor_append_expr (&result->value.constructor, r, &e->where); + } + + return result; + +fail: + gfc_free_expr (result); + return NULL; +} + + /* Pull an inquiry result out of an expression. */ static bool @@ -1848,6 +1897,7 @@ find_inquiry_ref (gfc_expr *p, gfc_expr **newp) gfc_ref *inquiry_head; gfc_ref *ref_ss = NULL; gfc_expr *tmp; + bool nofail = false; tmp = gfc_copy_expr (p); @@ -1947,24 +1997,50 @@ find_inquiry_ref (gfc_expr *p, gfc_expr **newp) break; case INQUIRY_RE: - if (tmp->ts.type != BT_COMPLEX || tmp->expr_type != EXPR_CONSTANT) + if (tmp->ts.type != BT_COMPLEX) goto cleanup; if (!gfc_notify_std (GFC_STD_F2008, "RE part_ref at %C")) goto cleanup; + if (tmp->expr_type == EXPR_ARRAY) + { + *newp = simplify_complex_array_inquiry_ref (tmp, INQUIRY_RE); + if (*newp != NULL) + { + nofail = true; + break; + } + } + + if (tmp->expr_type != EXPR_CONSTANT) + goto cleanup; + *newp = gfc_get_constant_expr (BT_REAL, tmp->ts.kind, &tmp->where); mpfr_set ((*newp)->value.real, mpc_realref (tmp->value.complex), GFC_RND_MODE); break; case INQUIRY_IM: - if (tmp->ts.type != BT_COMPLEX || tmp->expr_type != EXPR_CONSTANT) + if (tmp->ts.type != BT_COMPLEX) goto cleanup; if (!gfc_notify_std (GFC_STD_F2008, "IM part_ref at %C")) goto cleanup; + if (tmp->expr_type == EXPR_ARRAY) + { + *newp = simplify_complex_array_inquiry_ref (tmp, INQUIRY_IM); + if (*newp != NULL) + { + nofail = true; + break; + } + } + + if (tmp->expr_type != EXPR_CONSTANT) + goto cleanup; + *newp = gfc_get_constant_expr (BT_REAL, tmp->ts.kind, &tmp->where); mpfr_set ((*newp)->value.real, mpc_imagref (tmp->value.complex), GFC_RND_MODE); @@ -1977,7 +2053,7 @@ find_inquiry_ref (gfc_expr *p, gfc_expr **newp) if (!(*newp)) goto cleanup; - else if ((*newp)->expr_type != EXPR_CONSTANT) + else if ((*newp)->expr_type != EXPR_CONSTANT && !nofail) { gfc_free_expr (*newp); goto cleanup; @@ -2549,7 +2625,7 @@ scalarize_intrinsic_call (gfc_expr *e, bool init_flag) rank[n] = a->expr->rank; else rank[n] = 1; - ctor = gfc_constructor_copy (a->expr->value.constructor); + ctor = a->expr->value.constructor; args[n] = gfc_constructor_first (ctor); } else diff --git a/gcc/fortran/primary.cc b/gcc/fortran/primary.cc index 794c4b3..b5dddde 100644 --- a/gcc/fortran/primary.cc +++ b/gcc/fortran/primary.cc @@ -2716,6 +2716,9 @@ gfc_match_varspec (gfc_expr *primary, int equiv_flag, bool sub_flag, if (primary->expr_type == EXPR_CONSTANT) goto check_done; + if (primary->ref == NULL) + goto check_done; + switch (tmp->u.i) { case INQUIRY_RE: diff --git a/gcc/testsuite/gfortran.dg/inquiry_type_ref_8.f90 b/gcc/testsuite/gfortran.dg/inquiry_type_ref_8.f90 new file mode 100644 index 0000000..70ef621 --- /dev/null +++ b/gcc/testsuite/gfortran.dg/inquiry_type_ref_8.f90 @@ -0,0 +1,214 @@ +! { dg-do compile } +! { dg-additional-options "-O0 -fdump-tree-original -std=f2018" } +! +! PR fortran/102599 - type parameter inquiries and constant complex arrays +! PR fortran/114022 - likewise +! +! Everything below shall be simplified at compile time. + +module mod + implicit none + public :: wp, c0, z0, y, test1 + private + + integer :: j + integer, parameter :: n = 5 + integer, parameter :: wp = 8 + type :: cx + real(wp) :: re + real(wp) :: im + end type cx + type(cx), parameter :: c0(*) = [(cx (j,-j), j=1,n)] + complex(wp), parameter :: z0(*) = [(cmplx(j,-j,wp),j=1,n)] + + type :: my_type + complex(wp) :: z(n) = z0 + type(cx) :: c(n) = c0 + end type my_type + type(my_type), parameter :: y = my_type() + +contains + + ! Check simplification for inquiries of host-associated variables + subroutine test1 () + ! Inquiries and full arrays + real(wp), parameter :: r0(*) = real (z0) + real(wp), parameter :: i0(*) = aimag (z0) + real(wp), parameter :: r1(*) = c0 % re + real(wp), parameter :: i1(*) = c0 % im + real(wp), parameter :: r2(*) = z0 % re + real(wp), parameter :: i2(*) = z0 % im + real(wp), parameter :: r3(*) = y % c % re + real(wp), parameter :: i3(*) = y % c % im + real(wp), parameter :: r4(*) = y % z % re + real(wp), parameter :: i4(*) = y % z % im + + logical, parameter :: l1 = all (r1 == r0) + logical, parameter :: l2 = all (i1 == i0) + logical, parameter :: l3 = all (r1 == r2) + logical, parameter :: l4 = all (i1 == i2) + logical, parameter :: l5 = all (r3 == r4) + logical, parameter :: l6 = all (i3 == i4) + logical, parameter :: l7 = all (r1 == r3) + logical, parameter :: l8 = all (i1 == i3) + + ! Inquiries and array sections + real(wp), parameter :: p0(*) = real (z0(::2)) + real(wp), parameter :: q0(*) = aimag (z0(::2)) + real(wp), parameter :: p1(*) = c0(::2) % re + real(wp), parameter :: q1(*) = c0(::2) % im + real(wp), parameter :: p2(*) = z0(::2) % re + real(wp), parameter :: q2(*) = z0(::2) % im + real(wp), parameter :: p3(*) = y % c(::2) % re + real(wp), parameter :: q3(*) = y % c(::2) % im + real(wp), parameter :: p4(*) = y % z(::2) % re + real(wp), parameter :: q4(*) = y % z(::2) % im + + logical, parameter :: m1 = all (p1 == p0) + logical, parameter :: m2 = all (q1 == q0) + logical, parameter :: m3 = all (p1 == p2) + logical, parameter :: m4 = all (q1 == q2) + logical, parameter :: m5 = all (p3 == p4) + logical, parameter :: m6 = all (q3 == q4) + logical, parameter :: m7 = all (p1 == p3) + logical, parameter :: m8 = all (q1 == q3) + + ! Inquiries and vector subscripts + real(wp), parameter :: v0(*) = real (z0([3,2])) + real(wp), parameter :: w0(*) = aimag (z0([3,2])) + real(wp), parameter :: v1(*) = c0([3,2]) % re + real(wp), parameter :: w1(*) = c0([3,2]) % im + real(wp), parameter :: v2(*) = z0([3,2]) % re + real(wp), parameter :: w2(*) = z0([3,2]) % im + real(wp), parameter :: v3(*) = y % c([3,2]) % re + real(wp), parameter :: w3(*) = y % c([3,2]) % im + real(wp), parameter :: v4(*) = y % z([3,2]) % re + real(wp), parameter :: w4(*) = y % z([3,2]) % im + + logical, parameter :: o1 = all (v1 == v0) + logical, parameter :: o2 = all (w1 == w0) + logical, parameter :: o3 = all (v1 == v2) + logical, parameter :: o4 = all (w1 == w2) + logical, parameter :: o5 = all (v3 == v4) + logical, parameter :: o6 = all (w3 == w4) + logical, parameter :: o7 = all (v1 == v3) + logical, parameter :: o8 = all (w1 == w3) + + ! Miscellaneous + complex(wp), parameter :: x(-1:*) = cmplx (r1,i1,kind=wp) + real(x%re%kind), parameter :: r(*) = x % re + real(x%im%kind), parameter :: i(*) = x % im + real(x%re%kind), parameter :: s(*) = [ x(:) % re ] + real(x%im%kind), parameter :: t(*) = [ x(:) % im ] + + integer, parameter :: kr = x % re % kind + integer, parameter :: ki = x % im % kind + integer, parameter :: kx = x % kind + + if (kr /= wp .or. ki /= wp .or. kx /= wp) stop 1 + if (any (r /= r1)) stop 2 + if (any (i /= i1)) stop 3 + if (any (s /= r1)) stop 4 + if (any (t /= i1)) stop 5 + + if (.not. all ([l1,l2,l3,l4,l5,l6,l7,l8])) stop 6 + if (.not. all ([m1,m2,m3,m4,m5,m6,m7,m8])) stop 7 + if (.not. all ([o1,o2,o3,o4,o5,o6,o7,o8])) stop 8 + end subroutine test1 +end + +program p + use mod, only: wp, c0, z0, y, test1 + implicit none + call test1 () + call test2 () +contains + ! Check simplification for inquiries of use-associated variables + subroutine test2 () + ! Inquiries and full arrays + real(wp), parameter :: r0(*) = real (z0) + real(wp), parameter :: i0(*) = aimag (z0) + real(wp), parameter :: r1(*) = c0 % re + real(wp), parameter :: i1(*) = c0 % im + real(wp), parameter :: r2(*) = z0 % re + real(wp), parameter :: i2(*) = z0 % im + real(wp), parameter :: r3(*) = y % c % re + real(wp), parameter :: i3(*) = y % c % im + real(wp), parameter :: r4(*) = y % z % re + real(wp), parameter :: i4(*) = y % z % im + + logical, parameter :: l1 = all (r1 == r0) + logical, parameter :: l2 = all (i1 == i0) + logical, parameter :: l3 = all (r1 == r2) + logical, parameter :: l4 = all (i1 == i2) + logical, parameter :: l5 = all (r3 == r4) + logical, parameter :: l6 = all (i3 == i4) + logical, parameter :: l7 = all (r1 == r3) + logical, parameter :: l8 = all (i1 == i3) + + ! Inquiries and array sections + real(wp), parameter :: p0(*) = real (z0(::2)) + real(wp), parameter :: q0(*) = aimag (z0(::2)) + real(wp), parameter :: p1(*) = c0(::2) % re + real(wp), parameter :: q1(*) = c0(::2) % im + real(wp), parameter :: p2(*) = z0(::2) % re + real(wp), parameter :: q2(*) = z0(::2) % im + real(wp), parameter :: p3(*) = y % c(::2) % re + real(wp), parameter :: q3(*) = y % c(::2) % im + real(wp), parameter :: p4(*) = y % z(::2) % re + real(wp), parameter :: q4(*) = y % z(::2) % im + + logical, parameter :: m1 = all (p1 == p0) + logical, parameter :: m2 = all (q1 == q0) + logical, parameter :: m3 = all (p1 == p2) + logical, parameter :: m4 = all (q1 == q2) + logical, parameter :: m5 = all (p3 == p4) + logical, parameter :: m6 = all (q3 == q4) + logical, parameter :: m7 = all (p1 == p3) + logical, parameter :: m8 = all (q1 == q3) + + ! Inquiries and vector subscripts + real(wp), parameter :: v0(*) = real (z0([3,2])) + real(wp), parameter :: w0(*) = aimag (z0([3,2])) + real(wp), parameter :: v1(*) = c0([3,2]) % re + real(wp), parameter :: w1(*) = c0([3,2]) % im + real(wp), parameter :: v2(*) = z0([3,2]) % re + real(wp), parameter :: w2(*) = z0([3,2]) % im + real(wp), parameter :: v3(*) = y % c([3,2]) % re + real(wp), parameter :: w3(*) = y % c([3,2]) % im + real(wp), parameter :: v4(*) = y % z([3,2]) % re + real(wp), parameter :: w4(*) = y % z([3,2]) % im + + logical, parameter :: o1 = all (v1 == v0) + logical, parameter :: o2 = all (w1 == w0) + logical, parameter :: o3 = all (v1 == v2) + logical, parameter :: o4 = all (w1 == w2) + logical, parameter :: o5 = all (v3 == v4) + logical, parameter :: o6 = all (w3 == w4) + logical, parameter :: o7 = all (v1 == v3) + logical, parameter :: o8 = all (w1 == w3) + + ! Miscellaneous + complex(wp), parameter :: x(-1:*) = cmplx (r1,i1,kind=wp) + real(x%re%kind), parameter :: r(*) = x % re + real(x%im%kind), parameter :: i(*) = x % im + real(x%re%kind), parameter :: s(*) = [ x(:) % re ] + real(x%im%kind), parameter :: t(*) = [ x(:) % im ] + + integer, parameter :: kr = x % re % kind + integer, parameter :: ki = x % im % kind + integer, parameter :: kx = x % kind + + if (kr /= wp .or. ki /= wp .or. kx /= wp) stop 11 + if (any (r /= r1)) stop 12 + if (any (i /= i1)) stop 13 + if (any (s /= r1)) stop 14 + if (any (t /= i1)) stop 15 + + if (.not. all ([l1,l2,l3,l4,l5,l6,l7,l8])) stop 16 + if (.not. all ([m1,m2,m3,m4,m5,m6,m7,m8])) stop 17 + if (.not. all ([o1,o2,o3,o4,o5,o6,o7,o8])) stop 18 + end subroutine test2 +end + +! { dg-final { scan-tree-dump-not "_gfortran_stop_numeric" "original" } } -- cgit v1.1 From 55a920367eb34cb33a3ff22f5487a56baa1f93c6 Mon Sep 17 00:00:00 2001 From: GCC Administrator Date: Wed, 4 Jun 2025 00:27:33 +0000 Subject: Daily bump. --- gcc/DATESTAMP | 2 +- gcc/fortran/ChangeLog | 42 ++++++++++++++++++++++++++++++++++++++++++ gcc/testsuite/ChangeLog | 17 +++++++++++++++++ 3 files changed, 60 insertions(+), 1 deletion(-) (limited to 'gcc') diff --git a/gcc/DATESTAMP b/gcc/DATESTAMP index 42c5479..932c2dd 100644 --- a/gcc/DATESTAMP +++ b/gcc/DATESTAMP @@ -1 +1 @@ -20250603 +20250604 diff --git a/gcc/fortran/ChangeLog b/gcc/fortran/ChangeLog index b987938..e98b205 100644 --- a/gcc/fortran/ChangeLog +++ b/gcc/fortran/ChangeLog @@ -1,3 +1,45 @@ +2025-06-03 Harald Anlauf + + Backported from master: + 2025-05-30 Harald Anlauf + + PR fortran/102599 + PR fortran/114022 + * expr.cc (simplify_complex_array_inquiry_ref): Helper function for + simplification of inquiry references (%re/%im) of constant complex + arrays. + (find_inquiry_ref): Use it for handling %re/%im inquiry references + of complex arrays. + (scalarize_intrinsic_call): Fix frontend memleak. + * primary.cc (gfc_match_varspec): When the reference is NULL, the + previous simplification has succeeded in evaluating inquiry + references also of arrays. + +2025-06-03 Harald Anlauf + + Backported from master: + 2025-05-27 Harald Anlauf + + PR fortran/101735 + * primary.cc (gfc_match_varspec): Correct order of logic. + +2025-06-03 Harald Anlauf + + Backported from master: + 2025-05-27 Harald Anlauf + + PR fortran/101735 + * expr.cc (find_inquiry_ref): If an inquiry reference applies to + a substring, use that, and calculate substring length if needed. + * primary.cc (extend_ref): Also handle attaching to end of + reference chain for appending. + (gfc_match_varspec): Discrimate between arrays of character and + substrings of them. If a substring is taken from a character + component of a derived type, get the proper typespec so that + inquiry references work correctly. + (gfc_match_rvalue): Handle corner case where we hit a seemingly + dangling '%' and missed an inquiry reference. Try another match. + 2025-06-02 Jakub Jelinek Backported from master: diff --git a/gcc/testsuite/ChangeLog b/gcc/testsuite/ChangeLog index 73ae83d..9674984 100644 --- a/gcc/testsuite/ChangeLog +++ b/gcc/testsuite/ChangeLog @@ -1,3 +1,20 @@ +2025-06-03 Harald Anlauf + + Backported from master: + 2025-05-30 Harald Anlauf + + PR fortran/102599 + PR fortran/114022 + * gfortran.dg/inquiry_type_ref_8.f90: New test. + +2025-06-03 Harald Anlauf + + Backported from master: + 2025-05-27 Harald Anlauf + + PR fortran/101735 + * gfortran.dg/inquiry_type_ref_7.f90: New test. + 2025-06-02 Jason Merrill PR c++/120123 -- cgit v1.1 From c77dd2d7d40d4fb0d141bf61544d8a57d501f981 Mon Sep 17 00:00:00 2001 From: Harald Anlauf Date: Tue, 3 Jun 2025 20:48:31 +0200 Subject: Fortran: ICE due to missing locus with data statement for coarray [PR99838] PR fortran/99838 gcc/fortran/ChangeLog: * data.cc (gfc_assign_data_value): For a new initializer use the location from the constructor as fallback. gcc/testsuite/ChangeLog: * gfortran.dg/coarray_data_2.f90: New test. (cherry picked from commit 0768ec0d32f570b1db13ca41b0a1506275c44053) --- gcc/fortran/data.cc | 8 +++++++- gcc/testsuite/gfortran.dg/coarray_data_2.f90 | 14 ++++++++++++++ 2 files changed, 21 insertions(+), 1 deletion(-) create mode 100644 gcc/testsuite/gfortran.dg/coarray_data_2.f90 (limited to 'gcc') diff --git a/gcc/fortran/data.cc b/gcc/fortran/data.cc index 5c83f69..a438c26 100644 --- a/gcc/fortran/data.cc +++ b/gcc/fortran/data.cc @@ -593,7 +593,13 @@ gfc_assign_data_value (gfc_expr *lvalue, gfc_expr *rvalue, mpz_t index, { /* Point the container at the new expression. */ if (last_con == NULL) - symbol->value = expr; + { + symbol->value = expr; + /* For a new initializer use the location from the + constructor as fallback. */ + if (!GFC_LOCUS_IS_SET(expr->where) && con != NULL) + symbol->value->where = con->where; + } else last_con->expr = expr; } diff --git a/gcc/testsuite/gfortran.dg/coarray_data_2.f90 b/gcc/testsuite/gfortran.dg/coarray_data_2.f90 new file mode 100644 index 0000000..bda57f3 --- /dev/null +++ b/gcc/testsuite/gfortran.dg/coarray_data_2.f90 @@ -0,0 +1,14 @@ +! { dg-do compile } +! { dg-additional-options "-fcoarray=lib -Warray-temporaries" } +! +! PR fortran/99838 - ICE due to missing locus with data statement for coarray +! +! Contributed by Gerhard Steinmetz + +program p + type t + integer :: a + end type + type(t) :: x(3)[*] + data x%a /1, 2, 3/ ! { dg-warning "Creating array temporary" } +end -- cgit v1.1 From ea8d197fe2985c00a023e1d120923df60c2c6c14 Mon Sep 17 00:00:00 2001 From: GCC Administrator Date: Thu, 5 Jun 2025 00:26:06 +0000 Subject: Daily bump. --- gcc/DATESTAMP | 2 +- gcc/fortran/ChangeLog | 9 +++++++++ gcc/testsuite/ChangeLog | 8 ++++++++ 3 files changed, 18 insertions(+), 1 deletion(-) (limited to 'gcc') diff --git a/gcc/DATESTAMP b/gcc/DATESTAMP index 932c2dd..520e78d 100644 --- a/gcc/DATESTAMP +++ b/gcc/DATESTAMP @@ -1 +1 @@ -20250604 +20250605 diff --git a/gcc/fortran/ChangeLog b/gcc/fortran/ChangeLog index e98b205..c470df3 100644 --- a/gcc/fortran/ChangeLog +++ b/gcc/fortran/ChangeLog @@ -1,3 +1,12 @@ +2025-06-04 Harald Anlauf + + Backported from master: + 2025-06-03 Harald Anlauf + + PR fortran/99838 + * data.cc (gfc_assign_data_value): For a new initializer use the + location from the constructor as fallback. + 2025-06-03 Harald Anlauf Backported from master: diff --git a/gcc/testsuite/ChangeLog b/gcc/testsuite/ChangeLog index 9674984..0dc3767 100644 --- a/gcc/testsuite/ChangeLog +++ b/gcc/testsuite/ChangeLog @@ -1,3 +1,11 @@ +2025-06-04 Harald Anlauf + + Backported from master: + 2025-06-03 Harald Anlauf + + PR fortran/99838 + * gfortran.dg/coarray_data_2.f90: New test. + 2025-06-03 Harald Anlauf Backported from master: -- cgit v1.1 From d9fb0b4d8a401cc64d59eb49e3617f7c32cefb19 Mon Sep 17 00:00:00 2001 From: Eric Botcazou Date: Thu, 5 Jun 2025 13:20:26 +0200 Subject: Fix crash with constant initializer caused by IPA The testcase compiled with -O2 -gnatn makes the compiler crash in vect_can_force_dr_alignment_p during SLP vectorization: if (decl_in_symtab_p (decl) && !symtab_node::get (decl)->can_increase_alignment_p ()) return false; because symtab_node::get (decl) returns a null node. The phenomenon occurs for a pair of twin symbols listed like so in .cgraph: Opt7_Pkg.T12b/17 (Opt7_Pkg.T12b) Type: variable definition analyzed Visibility: semantic_interposition external public artificial Aux: @0x44d45e0 References: Referring: opt7_pkg__enum_name_table/13 (addr) opt7_pkg__enum_name_table/13 (addr) Availability: not-ready Varpool flags: initialized read-only const-value-known Opt7_Pkg.T8b/16 (Opt7_Pkg.T8b) Type: variable definition analyzed Visibility: semantic_interposition external public artificial Aux: @0x7f9fda3fff00 References: Referring: opt7_pkg__enum_name_table/13 (addr) opt7_pkg__enum_name_table/13 (addr) Availability: not-ready Varpool flags: initialized read-only const-value-known with: opt7_pkg__enum_name_table/13 (Opt7_Pkg.Enum_Name_Table) Type: variable definition analyzed Visibility: semantic_interposition external public Aux: @0x44d45e0 References: Opt7_Pkg.T8b/16 (addr) Opt7_Pkg.T8b/16 (addr) Opt7_Pkg.T12b/17 (addr) Opt7_Pkg.T12b/17 (addr) Referring: opt7_pkg__image/2 (read) opt7_pkg__image/2 (read) opt7_pkg__image/2 (read) opt7_pkg__image/2 (read) opt7_pkg__image/2 (read) opt7_pkg__image/2 (read) opt7_pkg__image/2 (read) opt7_pkg__image/2 (read) Availability: not-ready Varpool flags: initialized read-only const-value-known being the crux of the matter. What happens is that symtab_remove_unreachable_nodes leaves the last symbol in kind of a limbo state: in .remove_symbols, we have: opt7_pkg__enum_name_table/13 (Opt7_Pkg.Enum_Name_Table) Type: variable Body removed by symtab_remove_unreachable_nodes Visibility: externally_visible semantic_interposition external public References: Referring: opt7_pkg__image/2 (read) opt7_pkg__image/2 (read) Availability: not_available Varpool flags: initialized read-only const-value-known This means that the "body" (DECL_INITIAL) of the symbol has been disregarded during reachability analysis, causing the first two symbols to be discarded: Reclaiming variables: Opt7_Pkg.T12b/17 Opt7_Pkg.T8b/16 but the DECL_INITIAL is explicitly preserved for later constant folding, which makes it possible to retrofit the DECLs corresponding to the first two symbols in the GIMPLE IR and ultimately leads to the crash. gcc/ * tree-vect-data-refs.cc (vect_can_force_dr_alignment_p): Return false if the variable has no symtab node. gcc/testsuite/ * gnat.dg/specs/opt7.ads: New test. * gnat.dg/specs/opt7_pkg.ads: New helper. * gnat.dg/specs/opt7_pkg.adb: Likewise. --- gcc/testsuite/gnat.dg/specs/opt7.ads | 15 +++++++++++++++ gcc/testsuite/gnat.dg/specs/opt7_pkg.adb | 15 +++++++++++++++ gcc/testsuite/gnat.dg/specs/opt7_pkg.ads | 9 +++++++++ gcc/tree-vect-data-refs.cc | 3 ++- 4 files changed, 41 insertions(+), 1 deletion(-) create mode 100644 gcc/testsuite/gnat.dg/specs/opt7.ads create mode 100644 gcc/testsuite/gnat.dg/specs/opt7_pkg.adb create mode 100644 gcc/testsuite/gnat.dg/specs/opt7_pkg.ads (limited to 'gcc') diff --git a/gcc/testsuite/gnat.dg/specs/opt7.ads b/gcc/testsuite/gnat.dg/specs/opt7.ads new file mode 100644 index 0000000..ee151f0 --- /dev/null +++ b/gcc/testsuite/gnat.dg/specs/opt7.ads @@ -0,0 +1,15 @@ +-- { dg-do compile } +-- { dg-options "-O2 -gnatn" } + +with Opt7_Pkg; use Opt7_Pkg; + +package Opt7 is + + type Rec is record + E : Enum; + end record; + + function Image (R : Rec) return String is + (if R.E = A then Image (R.E) else ""); + +end Opt7; diff --git a/gcc/testsuite/gnat.dg/specs/opt7_pkg.adb b/gcc/testsuite/gnat.dg/specs/opt7_pkg.adb new file mode 100644 index 0000000..1c9d79b --- /dev/null +++ b/gcc/testsuite/gnat.dg/specs/opt7_pkg.adb @@ -0,0 +1,15 @@ +package body Opt7_Pkg is + + type Constant_String_Access is access constant String; + + type Enum_Name is array (Enum) of Constant_String_Access; + + Enum_Name_Table : constant Enum_Name := + (A => new String'("A"), B => new String'("B")); + + function Image (E : Enum) return String is + begin + return Enum_Name_Table (E).all; + end Image; + +end Opt7_Pkg; diff --git a/gcc/testsuite/gnat.dg/specs/opt7_pkg.ads b/gcc/testsuite/gnat.dg/specs/opt7_pkg.ads new file mode 100644 index 0000000..2dd271b --- /dev/null +++ b/gcc/testsuite/gnat.dg/specs/opt7_pkg.ads @@ -0,0 +1,9 @@ +-- { dg-excess-errors "no code generated" } + +package Opt7_Pkg is + + type Enum is (A, B); + + function Image (E : Enum) return String with Inline; + +end Opt7_Pkg; diff --git a/gcc/tree-vect-data-refs.cc b/gcc/tree-vect-data-refs.cc index 3ba271b..4ca9ab7 100644 --- a/gcc/tree-vect-data-refs.cc +++ b/gcc/tree-vect-data-refs.cc @@ -7151,7 +7151,8 @@ vect_can_force_dr_alignment_p (const_tree decl, poly_uint64 alignment) return false; if (decl_in_symtab_p (decl) - && !symtab_node::get (decl)->can_increase_alignment_p ()) + && (!symtab_node::get (decl) + || !symtab_node::get (decl)->can_increase_alignment_p ())) return false; if (TREE_STATIC (decl)) -- cgit v1.1 From a52223c5b2ba677468b5fabc010492998e4dea3a Mon Sep 17 00:00:00 2001 From: Gary Dismukes Date: Fri, 10 Jan 2025 22:39:52 +0000 Subject: ada: Compiler crash on array aggregate association iterating over function result The compiler triggers a bug box when compiling an array aggregate with an iterated_component_association that iterates over another array object, failing when trying to retrieve a Choices field, which isn't an allowed field for N_Iterated_Component_Association nodes. This occurs in procedure Check_Function_Writable_Actuals, which wasn't accounting for the iterated association forms. gcc/ada/ChangeLog: * sem_util.adb (Check_Function_Writable_Actuals): Add handling for N_Iterated_Component_Association and N_Iterated_Element_Association. Fix a typo in an RM reference (6.4.1(20/3) => 6.4.1(6.20/3)). (Collect_Expression_Ids): New procedure factoring code for collecting identifiers from expressions of aggregate associations. (Handle_Association_Choices): New procedure factoring code for handling id collection for expressions of aggregate associations with multiple choices. Removed redundant test of Box_Present from original code. --- gcc/ada/sem_util.adb | 115 ++++++++++++++++++++++++++++++++++++++------------- 1 file changed, 86 insertions(+), 29 deletions(-) (limited to 'gcc') diff --git a/gcc/ada/sem_util.adb b/gcc/ada/sem_util.adb index 0e1505b..5f9f275 100644 --- a/gcc/ada/sem_util.adb +++ b/gcc/ada/sem_util.adb @@ -3025,7 +3025,7 @@ package body Sem_Util is -- For an array aggregate, a discrete_choice_list that has -- a nonstatic range is considered as two or more separate - -- occurrences of the expression (RM 6.4.1(20/3)). + -- occurrences of the expression (RM 6.4.1(6.20/3)). elsif Is_Array_Type (Etype (N)) and then Nkind (N) = N_Aggregate @@ -3110,48 +3110,105 @@ package body Sem_Util is end loop; end if; - -- Handle discrete associations + -- Handle named associations if Present (Component_Associations (N)) then Assoc := First (Component_Associations (N)); while Present (Assoc) loop - if not Box_Present (Assoc) then - Choice := First (Choices (Assoc)); - while Present (Choice) loop + Handle_Association : declare - -- For now we skip discriminants since it requires - -- performing the analysis in two phases: first one - -- analyzing discriminants and second one analyzing - -- the rest of components since discriminants are - -- evaluated prior to components: too much extra - -- work to detect a corner case??? + procedure Collect_Expression_Ids (Expr : Node_Id); + -- Collect identifiers in association expression Expr - if Nkind (Choice) in N_Has_Entity - and then Present (Entity (Choice)) - and then Ekind (Entity (Choice)) = E_Discriminant - then - null; + procedure Handle_Association_Choices + (Choices : List_Id; Expr : Node_Id); + -- Collect identifiers in an association expression + -- Expr for each choice in Choices. - elsif Box_Present (Assoc) then - null; + ---------------------------- + -- Collect_Expression_Ids -- + ---------------------------- + procedure Collect_Expression_Ids (Expr : Node_Id) is + Comp_Expr : Node_Id; + + begin + if not Analyzed (Expr) then + Comp_Expr := New_Copy_Tree (Expr); + Set_Parent (Comp_Expr, Parent (N)); + Preanalyze_Without_Errors (Comp_Expr); else - if not Analyzed (Expression (Assoc)) then - Comp_Expr := - New_Copy_Tree (Expression (Assoc)); - Set_Parent (Comp_Expr, Parent (N)); - Preanalyze_Without_Errors (Comp_Expr); + Comp_Expr := Expr; + end if; + + Collect_Identifiers (Comp_Expr); + end Collect_Expression_Ids; + + -------------------------------- + -- Handle_Association_Choices -- + -------------------------------- + + procedure Handle_Association_Choices + (Choices : List_Id; Expr : Node_Id) + is + Choice : Node_Id := First (Choices); + + begin + while Present (Choice) loop + + -- For now skip discriminants since it requires + -- performing analysis in two phases: first one + -- analyzing discriminants and second analyzing + -- the rest of components since discriminants + -- are evaluated prior to components: too much + -- extra work to detect a corner case??? + + if Nkind (Choice) in N_Has_Entity + and then Present (Entity (Choice)) + and then + Ekind (Entity (Choice)) = E_Discriminant + then + null; + else - Comp_Expr := Expression (Assoc); + Collect_Expression_Ids (Expr); end if; - Collect_Identifiers (Comp_Expr); - end if; + Next (Choice); + end loop; + end Handle_Association_Choices; - Next (Choice); - end loop; - end if; + begin + if not Box_Present (Assoc) then + if Nkind (Assoc) = N_Component_Association then + Handle_Association_Choices + (Choices (Assoc), Expression (Assoc)); + + elsif + Nkind (Assoc) = N_Iterated_Component_Association + and then Present (Defining_Identifier (Assoc)) + then + Handle_Association_Choices + (Discrete_Choices (Assoc), Expression (Assoc)); + + -- Nkind (Assoc) = N_Iterated_Component_Association + -- with iterator_specification, or + -- Nkind (Assoc) = N_Iterated_Element_Association + -- with loop_parameter_specification + -- or iterator_specification + -- + -- It seems that we might also need to deal with + -- iterable/iterator_names and iterator_filters + -- within iterator_specifications, and range bounds + -- within loop_parameter_specifications, but the + -- utility of doing that seems very low. ??? + + else + Collect_Expression_Ids (Expression (Assoc)); + end if; + end if; + end Handle_Association; Next (Assoc); end loop; -- cgit v1.1 From 29447fb66f7cf4a515cbbcc812008092d519bc9c Mon Sep 17 00:00:00 2001 From: Steve Baird Date: Fri, 10 Jan 2025 13:15:18 -0800 Subject: ada: Avoid calling Resolve with Stand.Any_Fixed as the expected type When we call Resolve for an expression, we pass in the expected type for that expression. In the absence of semantic errors, that expected type should never be any of the "Any_xxx" types declared in stand.ads (e.g., Any_Array, Any_Numeric, Any_Real). In particular, it should never be Any_Fixed. Fix a case in which this rule was being violated. gcc/ada/ChangeLog: * sem_res.adb (Set_Mixed_Mode_Operand): If we are about to call Resolve passing in Any_Fixed as the expected type, then instead pass in the fixed point type of the other operand (i.e., B_Typ). --- gcc/ada/sem_res.adb | 2 ++ 1 file changed, 2 insertions(+) (limited to 'gcc') diff --git a/gcc/ada/sem_res.adb b/gcc/ada/sem_res.adb index b73b947..0df6c27 100644 --- a/gcc/ada/sem_res.adb +++ b/gcc/ada/sem_res.adb @@ -6101,6 +6101,8 @@ package body Sem_Res is elsif Is_Fixed_Point_Type (It.Typ) then if Analyzed (N) then Error_Msg_N ("ambiguous operand in fixed operation", N); + elsif It.Typ = Any_Fixed then + Resolve (N, B_Typ); else Resolve (N, It.Typ); end if; -- cgit v1.1 From 5738c9b74bd77821b6c7438ea4e5fa1853d3f07a Mon Sep 17 00:00:00 2001 From: Steve Baird Date: Mon, 13 Jan 2025 14:18:26 -0800 Subject: ada: Fix compile-time failure due to duplicated attribute subprograms. For a given type, and for certain attributes (the 4 streaming attributes and, for Ada2022, the Put_Image attribute), the compiler needs to keep track of whether a subprogram has already been generated for the given type/attribute pair. In some cases this was being done incorrectly; the compiler ended up generating duplicate subprograms (with the same name), resulting in compilation failures. This could occur if the prefix of an attribute reference denoted a subtype (more precisely, a non-first subtype). This includes the case of a subtype declaration that is implicitly introduced by the compiler to capture the binding between a formal type in a generic and the corresponding actual type in an instantiation. gcc/ada/ChangeLog: * exp_attr.adb (Expand_N_Attribute_Reference): When accessing the maps declared in package Cached_Attribute_Ops, the key value passed to Get or to Set should never be the entity node for a subtype. Use the entity of the corresponding type declaration instead. --- gcc/ada/exp_attr.adb | 39 ++++++++++++++++++++++++--------------- 1 file changed, 24 insertions(+), 15 deletions(-) (limited to 'gcc') diff --git a/gcc/ada/exp_attr.adb b/gcc/ada/exp_attr.adb index b896228..aea9e8a 100644 --- a/gcc/ada/exp_attr.adb +++ b/gcc/ada/exp_attr.adb @@ -88,8 +88,10 @@ package body Exp_Attr is function Attribute_Op_Hash (Id : Entity_Id) return Header_Num is (Header_Num (Id mod Map_Size)); - -- Cache used to avoid building duplicate subprograms for a single - -- type/streaming-attribute pair. + -- Caches used to avoid building duplicate subprograms for a single + -- type/attribute pair (where the attribute is either Put_Image or + -- one of the four streaming attributes). The type used as a key in + -- in accessing these maps should not be the entity of a subtype. package Read_Map is new GNAT.HTable.Simple_HTable (Header_Num => Header_Num, @@ -4669,7 +4671,7 @@ package body Exp_Attr is end if; if not Is_Tagged_Type (P_Type) then - Cached_Attribute_Ops.Input_Map.Set (P_Type, Fname); + Cached_Attribute_Ops.Input_Map.Set (U_Type, Fname); end if; end Input; @@ -5750,7 +5752,7 @@ package body Exp_Attr is Rewrite_Attribute_Proc_Call (Pname); if not Is_Tagged_Type (P_Type) then - Cached_Attribute_Ops.Output_Map.Set (P_Type, Pname); + Cached_Attribute_Ops.Output_Map.Set (U_Type, Pname); end if; end Output; @@ -6669,7 +6671,7 @@ package body Exp_Attr is Rewrite_Attribute_Proc_Call (Pname); if not Is_Tagged_Type (P_Type) then - Cached_Attribute_Ops.Read_Map.Set (P_Type, Pname); + Cached_Attribute_Ops.Read_Map.Set (U_Type, Pname); end if; end Read; @@ -8349,7 +8351,7 @@ package body Exp_Attr is Rewrite_Attribute_Proc_Call (Pname); if not Is_Tagged_Type (P_Type) then - Cached_Attribute_Ops.Write_Map.Set (P_Type, Pname); + Cached_Attribute_Ops.Write_Map.Set (U_Type, Pname); end if; end Write; @@ -8951,15 +8953,22 @@ package body Exp_Attr is return Empty; end if; - if Nam = TSS_Stream_Read then - Ent := Cached_Attribute_Ops.Read_Map.Get (Typ); - elsif Nam = TSS_Stream_Write then - Ent := Cached_Attribute_Ops.Write_Map.Get (Typ); - elsif Nam = TSS_Stream_Input then - Ent := Cached_Attribute_Ops.Input_Map.Get (Typ); - elsif Nam = TSS_Stream_Output then - Ent := Cached_Attribute_Ops.Output_Map.Get (Typ); - end if; + declare + function U_Base return Entity_Id is + (Underlying_Type (Base_Type (Typ))); + -- Return the right type node for use in a C_A_O map lookup. + -- In particular, we do not want the entity for a subtype. + begin + if Nam = TSS_Stream_Read then + Ent := Cached_Attribute_Ops.Read_Map.Get (U_Base); + elsif Nam = TSS_Stream_Write then + Ent := Cached_Attribute_Ops.Write_Map.Get (U_Base); + elsif Nam = TSS_Stream_Input then + Ent := Cached_Attribute_Ops.Input_Map.Get (U_Base); + elsif Nam = TSS_Stream_Output then + Ent := Cached_Attribute_Ops.Output_Map.Get (U_Base); + end if; + end; Cached_Attribute_Ops.Validate_Cached_Candidate (Subp => Ent, Attr_Ref => Attr_Ref); -- cgit v1.1 From 09b0aacb5fce94199b269a9a37b697899f5a1ab3 Mon Sep 17 00:00:00 2001 From: Eric Botcazou Date: Wed, 15 Jan 2025 20:37:48 +0100 Subject: ada: Fix buffer overflow for function call returning discriminated limited record This occurs when the discriminated limited record type is declared with default values for its discriminants, is not controlled, and the context of the call is anonymous, i.e. the result of the call is not assigned to an object. In this case, a temporary is created to hold the result of the call, with the default values of the discriminants, but the result may have different values for the discriminants and, in particular, may be larger than the temporary, which leads to a buffer overflow. This problem does not occur when the context is an object declaration, so the fix just makes sure that the expansion in an anonymous context always uses the model of an object declaration. It requires a minor tweak to the helper function Entity_Of of the Sem_Util package. gcc/ada/ChangeLog: * exp_ch6.adb (Expand_Actuals): Remove obsolete comment. (Make_Build_In_Place_Call_In_Anonymous_Context): Always use a proper object declaration initialized with the function call in the cases where a temporary is needed, with Assignment_OK set on it. * sem_util.adb (Entity_Of): Deal with rewritten function call first. --- gcc/ada/exp_ch6.adb | 100 +++++++++++++-------------------------------------- gcc/ada/sem_util.adb | 18 +++++----- 2 files changed, 33 insertions(+), 85 deletions(-) (limited to 'gcc') diff --git a/gcc/ada/exp_ch6.adb b/gcc/ada/exp_ch6.adb index 7e46454..d5667b4 100644 --- a/gcc/ada/exp_ch6.adb +++ b/gcc/ada/exp_ch6.adb @@ -2470,11 +2470,6 @@ package body Exp_Ch6 is -- (and ensure that we have an activation chain defined for tasks -- and a Master variable). - -- Currently we limit such functions to those with inherently - -- limited result subtypes, but eventually we plan to expand the - -- functions that are treated as build-in-place to include other - -- composite result types. - -- But do not do it here for intrinsic subprograms since this will -- be done properly after the subprogram is expanded. @@ -8562,12 +8557,10 @@ package body Exp_Ch6 is procedure Make_Build_In_Place_Call_In_Anonymous_Context (Function_Call : Node_Id) is - Loc : constant Source_Ptr := Sloc (Function_Call); - Func_Call : constant Node_Id := Unqual_Conv (Function_Call); - Function_Id : Entity_Id; - Result_Subt : Entity_Id; - Return_Obj_Id : Entity_Id; - Return_Obj_Decl : Entity_Id; + Loc : constant Source_Ptr := Sloc (Function_Call); + Func_Call : constant Node_Id := Unqual_Conv (Function_Call); + Function_Id : Entity_Id; + Result_Subt : Entity_Id; begin -- If the call has already been processed to add build-in-place actuals @@ -8580,10 +8573,6 @@ package body Exp_Ch6 is return; end if; - -- Mark the call as processed as a build-in-place call - - Set_Is_Expanded_Build_In_Place_Call (Func_Call); - if Is_Entity_Name (Name (Func_Call)) then Function_Id := Entity (Name (Func_Call)); @@ -8601,8 +8590,13 @@ package body Exp_Ch6 is -- If the build-in-place function returns a controlled object, then the -- object needs to be finalized immediately after the context. Since -- this case produces a transient scope, the servicing finalizer needs - -- to name the returned object. Create a temporary which is initialized - -- with the function call: + -- to name the returned object. + + -- If the build-in-place function returns a definite subtype, then an + -- object also needs to be created and an access value designating it + -- passed as an actual. + + -- Create a temporary which is initialized with the function call: -- -- Temp_Id : Func_Type := BIP_Func_Call; -- @@ -8610,75 +8604,25 @@ package body Exp_Ch6 is -- the expander using the appropriate mechanism in Make_Build_In_Place_ -- Call_In_Object_Declaration. - if Needs_Finalization (Result_Subt) then + if Needs_Finalization (Result_Subt) + or else Caller_Known_Size (Func_Call, Result_Subt) + then declare Temp_Id : constant Entity_Id := Make_Temporary (Loc, 'R'); - Temp_Decl : Node_Id; - - begin - -- Reset the guard on the function call since the following does - -- not perform actual call expansion. - - Set_Is_Expanded_Build_In_Place_Call (Func_Call, False); - - Temp_Decl := + Temp_Decl : constant Node_Id := Make_Object_Declaration (Loc, Defining_Identifier => Temp_Id, - Object_Definition => - New_Occurrence_Of (Result_Subt, Loc), - Expression => - New_Copy_Tree (Function_Call)); + Aliased_Present => True, + Object_Definition => New_Occurrence_Of (Result_Subt, Loc), + Expression => Relocate_Node (Function_Call)); + begin + Set_Assignment_OK (Temp_Decl); Insert_Action (Function_Call, Temp_Decl); - Rewrite (Function_Call, New_Occurrence_Of (Temp_Id, Loc)); Analyze (Function_Call); end; - -- When the result subtype is definite, an object of the subtype is - -- declared and an access value designating it is passed as an actual. - - elsif Caller_Known_Size (Func_Call, Result_Subt) then - - -- Create a temporary object to hold the function result - - Return_Obj_Id := Make_Temporary (Loc, 'R'); - Set_Etype (Return_Obj_Id, Result_Subt); - - Return_Obj_Decl := - Make_Object_Declaration (Loc, - Defining_Identifier => Return_Obj_Id, - Aliased_Present => True, - Object_Definition => New_Occurrence_Of (Result_Subt, Loc)); - - Set_No_Initialization (Return_Obj_Decl); - - Insert_Action (Func_Call, Return_Obj_Decl); - - -- When the function has a controlling result, an allocation-form - -- parameter must be passed indicating that the caller is allocating - -- the result object. This is needed because such a function can be - -- called as a dispatching operation and must be treated similarly - -- to functions with unconstrained result subtypes. - - Add_Unconstrained_Actuals_To_Build_In_Place_Call - (Func_Call, Function_Id, Alloc_Form => Caller_Allocation); - - Add_Collection_Actual_To_Build_In_Place_Call - (Func_Call, Function_Id); - - Add_Task_Actuals_To_Build_In_Place_Call - (Func_Call, Function_Id, Make_Identifier (Loc, Name_uMaster)); - - -- Add an implicit actual to the function call that provides access - -- to the caller's return object. - - Add_Access_Actual_To_Build_In_Place_Call - (Func_Call, Function_Id, New_Occurrence_Of (Return_Obj_Id, Loc)); - - pragma Assert (Check_Number_Of_Actuals (Func_Call, Function_Id)); - pragma Assert (Check_BIP_Actuals (Func_Call, Function_Id)); - -- When the result subtype is unconstrained, the function must allocate -- the return object in the secondary stack, so appropriate implicit -- parameters are added to the call to indicate that. A transient @@ -8703,6 +8647,10 @@ package body Exp_Ch6 is Add_Access_Actual_To_Build_In_Place_Call (Func_Call, Function_Id, Empty); + -- Mark the call as processed as a build-in-place call + + Set_Is_Expanded_Build_In_Place_Call (Func_Call); + pragma Assert (Check_Number_Of_Actuals (Func_Call, Function_Id)); pragma Assert (Check_BIP_Actuals (Func_Call, Function_Id)); end if; diff --git a/gcc/ada/sem_util.adb b/gcc/ada/sem_util.adb index 5f9f275..b833b35 100644 --- a/gcc/ada/sem_util.adb +++ b/gcc/ada/sem_util.adb @@ -8120,12 +8120,20 @@ package body Sem_Util is loop Ren := Renamed_Object (Id); + -- The reference renames a function result. Check the original + -- node in case expansion relocates the function call. + + -- Ren : ... renames Func_Call; + + if Nkind (Original_Node (Ren)) = N_Function_Call then + exit; + -- The reference renames an abstract state or a whole object -- Obj : ...; -- Ren : ... renames Obj; - if Is_Entity_Name (Ren) then + elsif Is_Entity_Name (Ren) then -- Do not follow a renaming that goes through a generic formal, -- because these entities are hidden and must not be referenced @@ -8138,14 +8146,6 @@ package body Sem_Util is Id := Entity (Ren); end if; - -- The reference renames a function result. Check the original - -- node in case expansion relocates the function call. - - -- Ren : ... renames Func_Call; - - elsif Nkind (Original_Node (Ren)) = N_Function_Call then - exit; - -- Otherwise the reference renames something which does not yield -- an abstract state or a whole object. Treat the reference as not -- having a proper entity for SPARK legality purposes. -- cgit v1.1 From a871b236c17b818baa7437a313793058110e70f3 Mon Sep 17 00:00:00 2001 From: Gary Dismukes Date: Sat, 18 Jan 2025 01:11:12 +0000 Subject: ada: Error about assignment to limited target on aggregate with "for of" iterator The compiler reports a spurious error about an assignment to a limited object on an aggregate of a array type with limited components that has an association with a "for of" iterator. This is fixed by arranging to have the Assignment_OK flag set on the indexed_names generated by the expander for initializing the aggregate object. gcc/ada/ChangeLog: * exp_aggr.adb (Two_Pass_Aggregate_Expansion): Change call to Make_Assignment for the indexed aggregate object to call Change_Make_OK_Assignment instead. --- gcc/ada/exp_aggr.adb | 2 +- 1 file changed, 1 insertion(+), 1 deletion(-) (limited to 'gcc') diff --git a/gcc/ada/exp_aggr.adb b/gcc/ada/exp_aggr.adb index 7cb26ce..3c4576d 100644 --- a/gcc/ada/exp_aggr.adb +++ b/gcc/ada/exp_aggr.adb @@ -5749,7 +5749,7 @@ package body Exp_Aggr is while Present (Assoc) loop Iter := Iterator_Specification (Assoc); Iter_Id := Defining_Identifier (Iter); - New_Comp := Make_Assignment_Statement (Loc, + New_Comp := Make_OK_Assignment_Statement (Loc, Name => Make_Indexed_Component (Loc, Prefix => New_Occurrence_Of (TmpE, Loc), -- cgit v1.1 From 9f9476c195e4234f2bda930b5adee7d18d43d34e Mon Sep 17 00:00:00 2001 From: Viljar Indus Date: Mon, 20 Jan 2025 15:10:22 +0200 Subject: ada: Reject Valid_Value arguments originating from Standard The constraint for Valid_Value not applying to types from Standard should also apply to all types derived from those types. gcc/ada/ChangeLog: * doc/gnat_rm/implementation_defined_attributes.rst: Update the documentation for Valid_Value. * sem_attr.adb (Analyze_Attribute): Reject types where the root type originates from Standard. * gnat_rm.texi: Regenerate. --- gcc/ada/doc/gnat_rm/implementation_defined_attributes.rst | 6 +++--- gcc/ada/gnat_rm.texi | 6 +++--- gcc/ada/sem_attr.adb | 5 +++-- 3 files changed, 9 insertions(+), 8 deletions(-) (limited to 'gcc') diff --git a/gcc/ada/doc/gnat_rm/implementation_defined_attributes.rst b/gcc/ada/doc/gnat_rm/implementation_defined_attributes.rst index f051810..86d2a81 100644 --- a/gcc/ada/doc/gnat_rm/implementation_defined_attributes.rst +++ b/gcc/ada/doc/gnat_rm/implementation_defined_attributes.rst @@ -1629,9 +1629,9 @@ Attribute Valid_Value .. index:: Valid_Value The ``'Valid_Value`` attribute is defined for enumeration types other than -those in package Standard. This attribute is a function that takes -a String, and returns Boolean. ``T'Valid_Value (S)`` returns True -if and only if ``T'Value (S)`` would not raise Constraint_Error. +those in package Standard or types derived from those types. This attribute is +a function that takes a String, and returns Boolean. ``T'Valid_Value (S)`` +returns True if and only if ``T'Value (S)`` would not raise Constraint_Error. Attribute Valid_Scalars ======================= diff --git a/gcc/ada/gnat_rm.texi b/gcc/ada/gnat_rm.texi index 97469d7..54830b8 100644 --- a/gcc/ada/gnat_rm.texi +++ b/gcc/ada/gnat_rm.texi @@ -12360,9 +12360,9 @@ which changes element (1,2) to 20 and (3,4) to 30. @geindex Valid_Value The @code{'Valid_Value} attribute is defined for enumeration types other than -those in package Standard. This attribute is a function that takes -a String, and returns Boolean. @code{T'Valid_Value (S)} returns True -if and only if @code{T'Value (S)} would not raise Constraint_Error. +those in package Standard or types derived from those types. This attribute is +a function that takes a String, and returns Boolean. @code{T'Valid_Value (S)} +returns True if and only if @code{T'Value (S)} would not raise Constraint_Error. @node Attribute Valid_Scalars,Attribute VADS_Size,Attribute Valid_Value,Implementation Defined Attributes @anchor{gnat_rm/implementation_defined_attributes attribute-valid-scalars}@anchor{1c5} diff --git a/gcc/ada/sem_attr.adb b/gcc/ada/sem_attr.adb index af08fdb..08da29a 100644 --- a/gcc/ada/sem_attr.adb +++ b/gcc/ada/sem_attr.adb @@ -7511,13 +7511,14 @@ package body Sem_Attr is Set_Etype (N, Standard_Boolean); Validate_Non_Static_Attribute_Function_Call; - if P_Type in Standard_Boolean + if Root_Type (P_Type) in Standard_Boolean | Standard_Character | Standard_Wide_Character | Standard_Wide_Wide_Character then Error_Attr_P - ("prefix of % attribute must not be a type in Standard"); + ("prefix of % attribute must not be a type originating from " & + "Standard"); end if; if Discard_Names (First_Subtype (P_Type)) then -- cgit v1.1 From b7e10f86d5cbd95ac38a1141f3e0a95424ede281 Mon Sep 17 00:00:00 2001 From: Eric Botcazou Date: Fri, 24 Jan 2025 10:26:13 +0100 Subject: ada: Implement built-in-place expansion of two-pass array aggregates These are array aggregates containing only component associations that are iterated with iterator specifications, as per RM 4.3.3(20.2/5-20.4/5). It is implemented for the array aggregates that are used to initialize an object, as specified by RM 7.6(17.2/3-17.3/3) for immutably limited types and types that need finalization, but for all types like other aggregates. gcc/ada/ChangeLog: * exp_aggr.adb (Build_Two_Pass_Aggr_Code): New function containing most of the code initially present in Two_Pass_Aggregate_Expansion. (Two_Pass_Aggregate_Expansion): Remove redundant N parameter. Implement built-in-place expansion for (static) object declarations and allocators, using Build_Two_Pass_Aggr_Code for the main work. (Expand_Array_Aggregate): Adjust Two_Pass_Aggregate_Expansion call. Replace Etype (N) by Typ in a couple of places. * exp_ch3.adb (Expand_Freeze_Array_Type): Remove special case for two-pass array aggregates. (Expand_N_Object_Declaration): Do not adjust the object when it is initialized by a two-pass array aggregate. * exp_ch4.adb (Expand_Allocator_Expression): Apply the processing used for container aggregates to two-pass array aggregates. * exp_ch6.adb (Validate_Subprogram_Calls): Skip calls present in initialization expressions of N_Object_Declaration nodes that have No_Initialization set. * sem_ch3.adb (Analyze_Object_Declaration): Detect the cases of an array originally initialized by an aggregate consistently. --- gcc/ada/exp_aggr.adb | 498 +++++++++++++++++++++++++++++++-------------------- gcc/ada/exp_ch3.adb | 11 +- gcc/ada/exp_ch4.adb | 13 +- gcc/ada/exp_ch6.adb | 7 + gcc/ada/sem_ch3.adb | 11 +- 5 files changed, 324 insertions(+), 216 deletions(-) (limited to 'gcc') diff --git a/gcc/ada/exp_aggr.adb b/gcc/ada/exp_aggr.adb index 3c4576d..f2e7ad7 100644 --- a/gcc/ada/exp_aggr.adb +++ b/gcc/ada/exp_aggr.adb @@ -4956,6 +4956,14 @@ package body Exp_Aggr is -- type using the computable sizes of the aggregate and its sub- -- aggregates. + function Build_Two_Pass_Aggr_Code + (Lhs : Node_Id; + Aggr_Typ : out Entity_Id) return List_Id; + -- The aggregate consists only of iterated associations and Lhs is an + -- expression containing the location of the anonymous object, which + -- may be built in place. Returns the dynamic subtype of the aggregate + -- in Aggr_Typ and the list of statements needed to build it. + procedure Check_Bounds (Aggr_Bounds_Node, Index_Bounds_Node : Node_Id); -- Checks that the bounds of Aggr_Bounds are within the bounds defined -- by Index_Bounds. For null array aggregate (Ada 2022) check that the @@ -4983,7 +4991,7 @@ package body Exp_Aggr is -- built directly into the target of an assignment, the target must -- be free of side effects. N is the target of the assignment. - procedure Two_Pass_Aggregate_Expansion (N : Node_Id); + procedure Two_Pass_Aggregate_Expansion; -- If the aggregate consists only of iterated associations then the -- aggregate is constructed in two steps: -- a) Build an expression to compute the number of elements @@ -5053,6 +5061,221 @@ package body Exp_Aggr is Freeze_Itype (Agg_Type, N); end Build_Constrained_Type; + ------------------------------ + -- Build_Two_Pass_Aggr_Code -- + ------------------------------ + + function Build_Two_Pass_Aggr_Code + (Lhs : Node_Id; + Aggr_Typ : out Entity_Id) return List_Id + is + Index_Id : constant Entity_Id := Make_Temporary (Loc, 'I', N); + Index_Type : constant Entity_Id := Etype (First_Index (Typ)); + Index_Base : constant Entity_Id := Base_Type (Index_Type); + Size_Id : constant Entity_Id := Make_Temporary (Loc, 'I', N); + Size_Type : constant Entity_Id := + Integer_Type_For + (Esize (Index_Base), Is_Unsigned_Type (Index_Base)); + + Assoc : Node_Id; + Incr : Node_Id; + Iter : Node_Id; + New_Comp : Node_Id; + One_Loop : Node_Id; + Iter_Id : Entity_Id; + + Aggr_Code : List_Id; + Size_Expr_Code : List_Id; + + begin + Size_Expr_Code := New_List ( + Make_Object_Declaration (Loc, + Defining_Identifier => Size_Id, + Object_Definition => New_Occurrence_Of (Size_Type, Loc), + Expression => Make_Integer_Literal (Loc, 0))); + + -- First pass: execute the iterators to count the number of elements + -- that will be generated. + + Assoc := First (Component_Associations (N)); + while Present (Assoc) loop + Iter := Iterator_Specification (Assoc); + Iter_Id := Defining_Identifier (Iter); + Incr := + Make_Assignment_Statement (Loc, + Name => New_Occurrence_Of (Size_Id, Loc), + Expression => + Make_Op_Add (Loc, + Left_Opnd => New_Occurrence_Of (Size_Id, Loc), + Right_Opnd => Make_Integer_Literal (Loc, 1))); + + -- Avoid using the same iterator definition in both loops by + -- creating a new iterator for each loop and mapping it over the + -- original iterator references. + + One_Loop := + Make_Implicit_Loop_Statement (N, + Iteration_Scheme => + Make_Iteration_Scheme (Loc, + Iterator_Specification => + New_Copy_Tree (Iter, + Map => New_Elmt_List (Iter_Id, New_Copy (Iter_Id)))), + Statements => New_List (Incr)); + + Append (One_Loop, Size_Expr_Code); + Next (Assoc); + end loop; + + Insert_Actions (N, Size_Expr_Code); + + -- Build a constrained subtype with the bounds deduced from + -- the size computed above and declare the aggregate object. + -- The index type is some discrete type, so the bounds of the + -- constrained subtype are computed as T'Val (integer bounds). + + declare + -- Pos_Lo := Index_Type'Pos (Index_Type'First) + + Pos_Lo : constant Node_Id := + Make_Attribute_Reference (Loc, + Prefix => New_Occurrence_Of (Index_Type, Loc), + Attribute_Name => Name_Pos, + Expressions => New_List ( + Make_Attribute_Reference (Loc, + Prefix => New_Occurrence_Of (Index_Type, Loc), + Attribute_Name => Name_First))); + + -- Corresponding index value, i.e. Index_Type'First + + Aggr_Lo : constant Node_Id := + Make_Attribute_Reference (Loc, + Prefix => New_Occurrence_Of (Index_Type, Loc), + Attribute_Name => Name_First); + + -- Pos_Hi := Pos_Lo + Size - 1 + + Pos_Hi : constant Node_Id := + Make_Op_Add (Loc, + Left_Opnd => Pos_Lo, + Right_Opnd => + Make_Op_Subtract (Loc, + Left_Opnd => New_Occurrence_Of (Size_Id, Loc), + Right_Opnd => Make_Integer_Literal (Loc, 1))); + + -- Corresponding index value + + Aggr_Hi : constant Node_Id := + Make_Attribute_Reference (Loc, + Prefix => New_Occurrence_Of (Index_Type, Loc), + Attribute_Name => Name_Val, + Expressions => New_List (Pos_Hi)); + + begin + Aggr_Typ := Make_Temporary (Loc, 'T'); + + Insert_Action (N, + Make_Subtype_Declaration (Loc, + Defining_Identifier => Aggr_Typ, + Subtype_Indication => + Make_Subtype_Indication (Loc, + Subtype_Mark => + New_Occurrence_Of (Base_Type (Typ), Loc), + Constraint => + Make_Index_Or_Discriminant_Constraint + (Loc, + Constraints => + New_List (Make_Range (Loc, Aggr_Lo, Aggr_Hi)))))); + end; + + -- Second pass: use the iterators to generate the elements of the + -- aggregate. We assume that the second evaluation of each iterator + -- generates the same number of elements as the first pass, and thus + -- consider that the execution is erroneous (even if the RM does not + -- state this explicitly) if the number of elements generated differs + -- between first and second pass. + + Assoc := First (Component_Associations (N)); + + -- Initialize insertion position to first array component + + Aggr_Code := New_List ( + Make_Object_Declaration (Loc, + Defining_Identifier => Index_Id, + Object_Definition => + New_Occurrence_Of (Index_Type, Loc), + Expression => + Make_Attribute_Reference (Loc, + Prefix => New_Copy_Tree (Lhs), + Attribute_Name => Name_First))); + + while Present (Assoc) loop + Iter := Iterator_Specification (Assoc); + Iter_Id := Defining_Identifier (Iter); + New_Comp := + Make_OK_Assignment_Statement (Loc, + Name => + Make_Indexed_Component (Loc, + Prefix => New_Copy_Tree (Lhs), + Expressions => + New_List (New_Occurrence_Of (Index_Id, Loc))), + Expression => Copy_Separate_Tree (Expression (Assoc))); + + -- Arrange for the component to be adjusted if need be (the call + -- will be generated by Make_Tag_Ctrl_Assignment). + + if Needs_Finalization (Ctyp) + and then not Is_Inherently_Limited_Type (Ctyp) + then + Set_No_Finalize_Actions (New_Comp); + else + Set_No_Ctrl_Actions (New_Comp); + end if; + + -- Advance index position for insertion + + Incr := + Make_Assignment_Statement (Loc, + Name => New_Occurrence_Of (Index_Id, Loc), + Expression => + Make_Attribute_Reference (Loc, + Prefix => New_Occurrence_Of (Index_Type, Loc), + Attribute_Name => Name_Succ, + Expressions => + New_List (New_Occurrence_Of (Index_Id, Loc)))); + + -- Add guard to skip last increment when upper bound is reached + + Incr := + Make_If_Statement (Loc, + Condition => + Make_Op_Ne (Loc, + Left_Opnd => New_Occurrence_Of (Index_Id, Loc), + Right_Opnd => + Make_Attribute_Reference (Loc, + Prefix => New_Occurrence_Of (Index_Type, Loc), + Attribute_Name => Name_Last)), + Then_Statements => New_List (Incr)); + + -- Avoid using the same iterator definition in both loops by + -- creating a new iterator for each loop and mapping it over + -- the original iterator references. + + One_Loop := + Make_Implicit_Loop_Statement (N, + Iteration_Scheme => + Make_Iteration_Scheme (Loc, + Iterator_Specification => + New_Copy_Tree (Iter, + Map => New_Elmt_List (Iter_Id, New_Copy (Iter_Id)))), + Statements => New_List (New_Comp, Incr)); + + Append (One_Loop, Aggr_Code); + Next (Assoc); + end loop; + + return Aggr_Code; + end Build_Two_Pass_Aggr_Code; + ------------------ -- Check_Bounds -- ------------------ @@ -5596,214 +5819,98 @@ package body Exp_Aggr is -- Two_Pass_Aggregate_Expansion -- ---------------------------------- - procedure Two_Pass_Aggregate_Expansion (N : Node_Id) is - Loc : constant Source_Ptr := Sloc (N); - Comp_Type : constant Entity_Id := Etype (N); - Index_Id : constant Entity_Id := Make_Temporary (Loc, 'I', N); - Index_Type : constant Entity_Id := Etype (First_Index (Etype (N))); - Index_Base : constant Entity_Id := Base_Type (Index_Type); - Size_Id : constant Entity_Id := Make_Temporary (Loc, 'I', N); - Size_Type : constant Entity_Id := - Integer_Type_For - (Esize (Index_Base), Is_Unsigned_Type (Index_Base)); - TmpE : constant Entity_Id := Make_Temporary (Loc, 'A', N); - - Assoc : Node_Id := First (Component_Associations (N)); - Incr : Node_Id; - Iter : Node_Id; - New_Comp : Node_Id; - One_Loop : Node_Id; - Iter_Id : Entity_Id; - - Size_Expr_Code : List_Id; - Insertion_Code : List_Id := New_List; + procedure Two_Pass_Aggregate_Expansion is + Aggr_Code : List_Id; + Aggr_Typ : Entity_Id; + Lhs : Node_Id; + Obj_Id : Entity_Id; + Par : Node_Id; begin - Size_Expr_Code := New_List ( - Make_Object_Declaration (Loc, - Defining_Identifier => Size_Id, - Object_Definition => New_Occurrence_Of (Size_Type, Loc), - Expression => Make_Integer_Literal (Loc, 0))); - - -- First pass: execute the iterators to count the number of elements - -- that will be generated. - - while Present (Assoc) loop - Iter := Iterator_Specification (Assoc); - Iter_Id := Defining_Identifier (Iter); - Incr := Make_Assignment_Statement (Loc, - Name => New_Occurrence_Of (Size_Id, Loc), - Expression => - Make_Op_Add (Loc, - Left_Opnd => New_Occurrence_Of (Size_Id, Loc), - Right_Opnd => Make_Integer_Literal (Loc, 1))); - - -- Avoid using the same iterator definition in both loops by - -- creating a new iterator for each loop and mapping it over the - -- original iterator references. - - One_Loop := Make_Implicit_Loop_Statement (N, - Iteration_Scheme => - Make_Iteration_Scheme (Loc, - Iterator_Specification => - New_Copy_Tree (Iter, - Map => New_Elmt_List (Iter_Id, New_Copy (Iter_Id)))), - Statements => New_List (Incr)); - - Append (One_Loop, Size_Expr_Code); - Next (Assoc); + Par := Parent (N); + while Nkind (Par) = N_Qualified_Expression loop + Par := Parent (Par); end loop; - Insert_Actions (N, Size_Expr_Code); - - -- Build a constrained subtype with the bounds deduced from - -- the size computed above and declare the aggregate object. - -- The index type is some discrete type, so the bounds of the - -- constrained subtype are computed as T'Val (integer bounds). - - declare - -- Pos_Lo := Index_Type'Pos (Index_Type'First) - - Pos_Lo : constant Node_Id := - Make_Attribute_Reference (Loc, - Prefix => New_Occurrence_Of (Index_Type, Loc), - Attribute_Name => Name_Pos, - Expressions => New_List ( - Make_Attribute_Reference (Loc, - Prefix => New_Occurrence_Of (Index_Type, Loc), - Attribute_Name => Name_First))); - - -- Corresponding index value, i.e. Index_Type'First + -- If the aggregate is the initialization expression of an object + -- declaration, we always build the aggregate in place, although + -- this is required only for immutably limited types and types + -- that need finalization, see RM 7.6(17.2/3-17.3/3). - Aggr_Lo : constant Node_Id := - Make_Attribute_Reference (Loc, - Prefix => New_Occurrence_Of (Index_Type, Loc), - Attribute_Name => Name_First); - - -- Pos_Hi := Pos_Lo + Size - 1 - - Pos_Hi : constant Node_Id := - Make_Op_Add (Loc, - Left_Opnd => Pos_Lo, - Right_Opnd => - Make_Op_Subtract (Loc, - Left_Opnd => New_Occurrence_Of (Size_Id, Loc), - Right_Opnd => Make_Integer_Literal (Loc, 1))); - - -- Corresponding index value - - Aggr_Hi : constant Node_Id := - Make_Attribute_Reference (Loc, - Prefix => New_Occurrence_Of (Index_Type, Loc), - Attribute_Name => Name_Val, - Expressions => New_List (Pos_Hi)); - - SubE : constant Entity_Id := Make_Temporary (Loc, 'T'); - SubD : constant Node_Id := - Make_Subtype_Declaration (Loc, - Defining_Identifier => SubE, - Subtype_Indication => - Make_Subtype_Indication (Loc, - Subtype_Mark => - New_Occurrence_Of (Etype (Comp_Type), Loc), - Constraint => - Make_Index_Or_Discriminant_Constraint - (Loc, - Constraints => - New_List (Make_Range (Loc, Aggr_Lo, Aggr_Hi))))); - - -- Create a temporary array of the above subtype which - -- will be used to capture the aggregate assignments. - - TmpD : constant Node_Id := - Make_Object_Declaration (Loc, - Defining_Identifier => TmpE, - Object_Definition => New_Occurrence_Of (SubE, Loc)); - - begin - Insert_Actions (N, New_List (SubD, TmpD)); - end; - - -- Second pass: use the iterators to generate the elements of the - -- aggregate. Insertion index starts at Index_Type'First. We - -- assume that the second evaluation of each iterator generates - -- the same number of elements as the first pass, and consider - -- that the execution is erroneous (even if the RM does not state - -- this explicitly) if the number of elements generated differs - -- between first and second pass. - - Assoc := First (Component_Associations (N)); + if Nkind (Par) = N_Object_Declaration then + Obj_Id := Defining_Identifier (Par); + Lhs := New_Occurrence_Of (Obj_Id, Loc); + Set_Assignment_OK (Lhs); + Aggr_Code := Build_Two_Pass_Aggr_Code (Lhs, Aggr_Typ); - -- Initialize insertion position to first array component. + -- Save the last assignment statement associated with the + -- aggregate when building a controlled object. This last + -- assignment is used by the finalization machinery when + -- marking an object as successfully initialized. - Insertion_Code := New_List ( - Make_Object_Declaration (Loc, - Defining_Identifier => Index_Id, - Object_Definition => - New_Occurrence_Of (Index_Type, Loc), - Expression => - Make_Attribute_Reference (Loc, - Prefix => New_Occurrence_Of (Index_Type, Loc), - Attribute_Name => Name_First))); + if Needs_Finalization (Typ) then + Mutate_Ekind (Obj_Id, E_Variable); + Set_Last_Aggregate_Assignment (Obj_Id, Last (Aggr_Code)); + end if; - while Present (Assoc) loop - Iter := Iterator_Specification (Assoc); - Iter_Id := Defining_Identifier (Iter); - New_Comp := Make_OK_Assignment_Statement (Loc, - Name => - Make_Indexed_Component (Loc, - Prefix => New_Occurrence_Of (TmpE, Loc), - Expressions => - New_List (New_Occurrence_Of (Index_Id, Loc))), - Expression => Copy_Separate_Tree (Expression (Assoc))); + -- If a transient scope has been created around the declaration, + -- we need to attach the code to it so that finalization actions + -- of the declaration will be inserted after it; otherwise, we + -- directly insert it after the declaration. In both cases, the + -- code will be analyzed after the declaration is processed, i.e. + -- once the actual subtype of the object is established. - -- Advance index position for insertion. + if Scope_Is_Transient and then Par = Node_To_Be_Wrapped then + Store_After_Actions_In_Scope_Without_Analysis (Aggr_Code); + else + Insert_List_After (Par, Aggr_Code); + end if; - Incr := Make_Assignment_Statement (Loc, - Name => New_Occurrence_Of (Index_Id, Loc), - Expression => - Make_Attribute_Reference (Loc, - Prefix => - New_Occurrence_Of (Index_Type, Loc), - Attribute_Name => Name_Succ, - Expressions => - New_List (New_Occurrence_Of (Index_Id, Loc)))); + Set_Etype (N, Aggr_Typ); + Set_No_Initialization (Par); - -- Add guard to skip last increment when upper bound is reached. + -- Likewise if it is the qualified expression of an allocator but, + -- in this case, we wait until after Expand_Allocator_Expression + -- rewrites the allocator as the initialization expression of an + -- object declaration, so that we have the left-hand side. - Incr := Make_If_Statement (Loc, - Condition => - Make_Op_Ne (Loc, - Left_Opnd => New_Occurrence_Of (Index_Id, Loc), - Right_Opnd => - Make_Attribute_Reference (Loc, - Prefix => New_Occurrence_Of (Index_Type, Loc), - Attribute_Name => Name_Last)), - Then_Statements => New_List (Incr)); + elsif Nkind (Par) = N_Allocator then + if Nkind (Parent (Par)) = N_Object_Declaration + and then + not Comes_From_Source (Defining_Identifier (Parent (Par))) + then + Obj_Id := Defining_Identifier (Parent (Par)); + Lhs := + Make_Explicit_Dereference (Loc, + Prefix => New_Occurrence_Of (Obj_Id, Loc)); + Set_Assignment_OK (Lhs); + Aggr_Code := Build_Two_Pass_Aggr_Code (Lhs, Aggr_Typ); - -- Avoid using the same iterator definition in both loops by - -- creating a new iterator for each loop and mapping it over the - -- original iterator references. + Insert_Actions_After (Parent (Par), Aggr_Code); - One_Loop := Make_Implicit_Loop_Statement (N, - Iteration_Scheme => - Make_Iteration_Scheme (Loc, - Iterator_Specification => - New_Copy_Tree (Iter, - Map => New_Elmt_List (Iter_Id, New_Copy (Iter_Id)))), - Statements => New_List (New_Comp, Incr)); + Set_Expression (Par, New_Occurrence_Of (Aggr_Typ, Loc)); + Set_No_Initialization (Par); + end if; - Append (One_Loop, Insertion_Code); - Next (Assoc); - end loop; + -- Otherwise we create a temporary for the anonymous object and + -- replace the aggregate with the temporary. - Insert_Actions (N, Insertion_Code); + else + Obj_Id := Make_Temporary (Loc, 'A', N); + Lhs := New_Occurrence_Of (Obj_Id, Loc); + Set_Assignment_OK (Lhs); - -- Depending on context this may not work for build-in-place - -- arrays ??? + Aggr_Code := Build_Two_Pass_Aggr_Code (Lhs, Aggr_Typ); + Prepend_To (Aggr_Code, + Make_Object_Declaration (Loc, + Defining_Identifier => Obj_Id, + Object_Definition => New_Occurrence_Of (Aggr_Typ, Loc))); - Rewrite (N, New_Occurrence_Of (TmpE, Loc)); + Insert_Actions (N, Aggr_Code); + Rewrite (N, Lhs); + Analyze_And_Resolve (N, Aggr_Typ); + end if; end Two_Pass_Aggregate_Expansion; -- Local variables @@ -5829,7 +5936,7 @@ package body Exp_Aggr is -- Aggregates that require a two-pass expansion are handled separately elsif Is_Two_Pass_Aggregate (N) then - Two_Pass_Aggregate_Expansion (N); + Two_Pass_Aggregate_Expansion; return; -- Do not attempt expansion if error already detected. We may reach this @@ -6002,12 +6109,11 @@ package body Exp_Aggr is -- static type imposed by the context. declare - Itype : constant Entity_Id := Etype (N); Index : Node_Id; Needs_Type : Boolean := False; begin - Index := First_Index (Itype); + Index := First_Index (Typ); while Present (Index) loop if not Is_OK_Static_Subtype (Etype (Index)) then Needs_Type := True; @@ -6019,7 +6125,7 @@ package body Exp_Aggr is if Needs_Type then Build_Constrained_Type (Positional => True); - Rewrite (N, Unchecked_Convert_To (Itype, N)); + Rewrite (N, Unchecked_Convert_To (Typ, N)); Analyze (N); end if; end; @@ -6147,7 +6253,7 @@ package body Exp_Aggr is then Tmp := Name (Parent_Node); - if Etype (Tmp) /= Etype (N) then + if Etype (Tmp) /= Typ then Apply_Length_Check (N, Etype (Tmp)); if Nkind (N) = N_Raise_Constraint_Error then @@ -7362,7 +7468,7 @@ package body Exp_Aggr is -- Likewise if the aggregate is the qualified expression of an allocator -- but, in this case, we wait until after Expand_Allocator_Expression -- rewrites the allocator as the initialization expression of an object - -- declaration to have the left hand side. + -- declaration, so that we have the left-hand side. elsif Nkind (Par) = N_Allocator then if Nkind (Parent (Par)) = N_Object_Declaration diff --git a/gcc/ada/exp_ch3.adb b/gcc/ada/exp_ch3.adb index bc46fd3..fa87149 100644 --- a/gcc/ada/exp_ch3.adb +++ b/gcc/ada/exp_ch3.adb @@ -5423,18 +5423,12 @@ package body Exp_Ch3 is -- with an initial value, its Init_Proc will never be called. The -- initial value itself may have been expanded into assignments, -- in which case the declaration has the No_Initialization flag. - -- The exception is when the initial value is a 2-pass aggregate, - -- because the special expansion used for it creates a temporary - -- that needs a fully-fledged initialization. if Is_Itype (Base) and then Nkind (Associated_Node_For_Itype (Base)) = N_Object_Declaration and then - ((Present (Expression (Associated_Node_For_Itype (Base))) - and then not - Is_Two_Pass_Aggregate - (Expression (Associated_Node_For_Itype (Base)))) + (Present (Expression (Associated_Node_For_Itype (Base))) or else No_Initialization (Associated_Node_For_Itype (Base))) then null; @@ -8293,12 +8287,15 @@ package body Exp_Ch3 is -- where the object has been initialized by a call to a function -- returning on the primary stack (see Expand_Ctrl_Function_Call) -- since no copy occurred, given that the type is by-reference. + -- Likewise if it is initialized by a 2-pass aggregate, since the + -- actual initialization will only occur during the second pass. -- Similarly, no adjustment is needed if we are going to rewrite -- the object declaration into a renaming declaration. if Needs_Finalization (Typ) and then not Is_Inherently_Limited_Type (Typ) and then Nkind (Expr_Q) /= N_Function_Call + and then not Is_Two_Pass_Aggregate (Expr_Q) and then not Rewrite_As_Renaming then Adj_Call := diff --git a/gcc/ada/exp_ch4.adb b/gcc/ada/exp_ch4.adb index 82978c7..8c72484 100644 --- a/gcc/ada/exp_ch4.adb +++ b/gcc/ada/exp_ch4.adb @@ -769,7 +769,6 @@ package body Exp_Ch4 is -- Local variables Aggr_In_Place : Boolean; - Container_Aggr : Boolean; Delayed_Cond_Expr : Boolean; TagT : Entity_Id := Empty; @@ -865,13 +864,15 @@ package body Exp_Ch4 is Aggr_In_Place := Is_Delayed_Aggregate (Exp); Delayed_Cond_Expr := Is_Delayed_Conditional_Expression (Exp); - Container_Aggr := Nkind (Exp) = N_Aggregate - and then Has_Aspect (T, Aspect_Aggregate); - -- An allocator with a container aggregate as qualified expression must - -- be rewritten into the form expected by Expand_Container_Aggregate. + -- An allocator with a container aggregate, resp. a 2-pass aggregate, + -- as qualified expression must be rewritten into the form expected by + -- Expand_Container_Aggregate, resp. Two_Pass_Aggregate_Expansion. - if Container_Aggr then + if Nkind (Exp) = N_Aggregate + and then (Has_Aspect (T, Aspect_Aggregate) + or else Is_Two_Pass_Aggregate (Exp)) + then Temp := Make_Temporary (Loc, 'P', N); Set_Analyzed (Exp, False); Insert_Action (N, diff --git a/gcc/ada/exp_ch6.adb b/gcc/ada/exp_ch6.adb index d5667b4..f85d977 100644 --- a/gcc/ada/exp_ch6.adb +++ b/gcc/ada/exp_ch6.adb @@ -9857,6 +9857,13 @@ package body Exp_Ch6 is return Skip; end if; + -- Skip calls placed in unexpanded initialization expressions + + when N_Object_Declaration => + if No_Initialization (Nod) then + return Skip; + end if; + -- Skip calls placed in subprogram specifications since function -- calls initializing default parameter values will be processed -- when the call to the subprogram is found (if the default actual diff --git a/gcc/ada/sem_ch3.adb b/gcc/ada/sem_ch3.adb index 74eac9c..4b5c5b1 100644 --- a/gcc/ada/sem_ch3.adb +++ b/gcc/ada/sem_ch3.adb @@ -4991,7 +4991,7 @@ package body Sem_Ch3 is if Is_Array_Type (T) and then No_Initialization (N) - and then Nkind (Original_Node (E)) = N_Aggregate + and then Nkind (Unqualify (Original_Node (E))) = N_Aggregate then Act_T := Etype (E); @@ -5137,10 +5137,7 @@ package body Sem_Ch3 is elsif Is_Array_Type (T) and then No_Initialization (N) - and then (Nkind (Original_Node (E)) = N_Aggregate - or else (Nkind (Original_Node (E)) = N_Qualified_Expression - and then Nkind (Original_Node (Expression - (Original_Node (E)))) = N_Aggregate)) + and then Nkind (Unqualify (Original_Node (E))) = N_Aggregate then if not Is_Entity_Name (Object_Definition (N)) then Act_T := Etype (E); @@ -6633,8 +6630,6 @@ package body Sem_Ch3 is end; end if; - -- Constrained array case - if No (T) then -- We might be creating more than one itype with the same Related_Id, -- e.g. for an array object definition and its initial value. Give @@ -6644,6 +6639,8 @@ package body Sem_Ch3 is T := Create_Itype (E_Void, P, Related_Id, 'T', Suffix_Index => -1); end if; + -- Constrained array case + if Nkind (Def) = N_Constrained_Array_Definition then Index := First (Discrete_Subtype_Definitions (Def)); -- cgit v1.1 From 6b1c8f47583c8fb35009b8dead605f623aeb5376 Mon Sep 17 00:00:00 2001 From: Ronan Desplanques Date: Fri, 31 Jan 2025 10:40:42 +0100 Subject: ada: Tweak caching of streaming subprograms gcc/ada/ChangeLog: * exp_attr.adb (Interunit_Ref_OK): Tweak categorization of compilation units. --- gcc/ada/exp_attr.adb | 4 ++-- 1 file changed, 2 insertions(+), 2 deletions(-) (limited to 'gcc') diff --git a/gcc/ada/exp_attr.adb b/gcc/ada/exp_attr.adb index aea9e8a..4e0052e 100644 --- a/gcc/ada/exp_attr.adb +++ b/gcc/ada/exp_attr.adb @@ -284,8 +284,8 @@ package body Exp_Attr is (In_Same_Extended_Unit (Subp_Unit, Attr_Ref_Unit) -- If subp declared in unit body, then we don't want to refer -- to it from within unit spec so return False in that case. - and then not (Body_Required (Attr_Ref_Unit) - and not Body_Required (Subp_Unit))); + and then not (not Is_Body (Unit (Attr_Ref_Unit)) + and Is_Body (Unit (Subp_Unit)))); -- Returns True if it is ok to refer to a cached subprogram declared in -- Subp_Unit from the point of an attribute reference occurring in -- Attr_Ref_Unit. Both arguments are usually N_Compilation_Nodes, -- cgit v1.1 From 257a8dc92efbc5f523d388da10d63bf126af2aa3 Mon Sep 17 00:00:00 2001 From: Ronan Desplanques Date: Mon, 27 Jan 2025 12:04:41 +0100 Subject: ada: Fix crash on access to protected return The generation of the check mandated by Ada issue AI05-0073 was not done handled properly for protected types when used through subtypes. This patch fixes the issue. gcc/ada/ChangeLog: * exp_ch4.adb (Tagged_Membership): Fix for protected types. --- gcc/ada/exp_ch4.adb | 5 +++-- 1 file changed, 3 insertions(+), 2 deletions(-) (limited to 'gcc') diff --git a/gcc/ada/exp_ch4.adb b/gcc/ada/exp_ch4.adb index 8c72484..eb9fb6b 100644 --- a/gcc/ada/exp_ch4.adb +++ b/gcc/ada/exp_ch4.adb @@ -15036,10 +15036,11 @@ package body Exp_Ch4 is -- Handle entities from the limited view - Orig_Right_Type : constant Entity_Id := Available_View (Etype (Right)); + Orig_Right_Type : constant Entity_Id := + Base_Type (Available_View (Etype (Right))); Full_R_Typ : Entity_Id; - Left_Type : Entity_Id := Available_View (Etype (Left)); + Left_Type : Entity_Id := Base_Type (Available_View (Etype (Left))); Right_Type : Entity_Id := Orig_Right_Type; Obj_Tag : Node_Id; -- cgit v1.1 From 48a5910dde566180a0a0878651a78ccece89be45 Mon Sep 17 00:00:00 2001 From: Steve Baird Date: Thu, 30 Jan 2025 13:28:50 -0800 Subject: ada: Exception-raising loop incorrectly eliminated If the body of a loop includes a raise statement then the loop should not be considered to be free of side-effects and therefore eligible for elimination by the compiler. gcc/ada/ChangeLog: * sem_util.adb (Side_Effect_Free_Statements): Return False if the statement list includes an explicit (i.e. Comes_From_Source) raise statement. --- gcc/ada/sem_util.adb | 7 ++++++- 1 file changed, 6 insertions(+), 1 deletion(-) (limited to 'gcc') diff --git a/gcc/ada/sem_util.adb b/gcc/ada/sem_util.adb index b833b35..7757e04 100644 --- a/gcc/ada/sem_util.adb +++ b/gcc/ada/sem_util.adb @@ -12425,9 +12425,14 @@ package body Sem_Util is while Present (Node) loop case Nkind (Node) is - when N_Null_Statement | N_Call_Marker | N_Raise_xxx_Error => + when N_Null_Statement | N_Call_Marker => null; + when N_Raise_xxx_Error => + if Comes_From_Source (Node) then + return False; + end if; + when N_Object_Declaration => if Present (Expression (Node)) and then not Side_Effect_Free (Expression (Node)) -- cgit v1.1 From d056ac5fce4cf6de698b4e1e4fe266e5ebbd0530 Mon Sep 17 00:00:00 2001 From: Javier Miranda Date: Thu, 6 Feb 2025 09:40:57 +0000 Subject: ada: Spurious compilation error with repeated loop index When multiple for-loop statements in the same scope use the same index name to iterate through container elements, the compiler reports a spurious error indicating a conflict between index names. gcc/ada/ChangeLog: * exp_ch7.adb (Process_Object_Declaration): Avoid generating duplicate names for master nodes. --- gcc/ada/exp_ch7.adb | 15 +++++++++++++++ 1 file changed, 15 insertions(+) (limited to 'gcc') diff --git a/gcc/ada/exp_ch7.adb b/gcc/ada/exp_ch7.adb index 67af1d7..905094c 100644 --- a/gcc/ada/exp_ch7.adb +++ b/gcc/ada/exp_ch7.adb @@ -2783,16 +2783,31 @@ package body Exp_Ch7 is Master_Node_Id := Make_Defining_Identifier (Master_Node_Loc, Chars => New_External_Name (Chars (Obj_Id), Suffix => "MN")); + Master_Node_Decl := Make_Master_Node_Declaration (Master_Node_Loc, Master_Node_Id, Obj_Id); Push_Scope (Scope (Obj_Id)); + + -- Avoid generating duplicate names for master nodes + + if Ekind (Obj_Id) = E_Loop_Parameter + and then + Present (Current_Entity_In_Scope (Chars (Master_Node_Id))) + then + Set_Chars (Master_Node_Id, + New_External_Name (Chars (Obj_Id), + Suffix => "MN", + Suffix_Index => -1)); + end if; + if not Has_Strict_Ctrl_Objs or else Count = 1 then Prepend_To (Decls, Master_Node_Decl); else Insert_Before (Decl, Master_Node_Decl); end if; + Analyze (Master_Node_Decl); Pop_Scope; -- cgit v1.1 From 63465629ea118d27e59f3d97a92db1461c8b591e Mon Sep 17 00:00:00 2001 From: GCC Administrator Date: Fri, 6 Jun 2025 00:24:58 +0000 Subject: Daily bump. --- gcc/ChangeLog | 5 +++ gcc/DATESTAMP | 2 +- gcc/ada/ChangeLog | 88 +++++++++++++++++++++++++++++++++++++++++++++++++ gcc/testsuite/ChangeLog | 6 ++++ 4 files changed, 100 insertions(+), 1 deletion(-) (limited to 'gcc') diff --git a/gcc/ChangeLog b/gcc/ChangeLog index 59f447c..d11e9f1 100644 --- a/gcc/ChangeLog +++ b/gcc/ChangeLog @@ -1,3 +1,8 @@ +2025-06-05 Eric Botcazou + + * tree-vect-data-refs.cc (vect_can_force_dr_alignment_p): Return + false if the variable has no symtab node. + 2025-05-29 Yuta Mukai Backported from master: diff --git a/gcc/DATESTAMP b/gcc/DATESTAMP index 520e78d..c6de4e3 100644 --- a/gcc/DATESTAMP +++ b/gcc/DATESTAMP @@ -1 +1 @@ -20250605 +20250606 diff --git a/gcc/ada/ChangeLog b/gcc/ada/ChangeLog index 89cb7d4..331a8ab 100644 --- a/gcc/ada/ChangeLog +++ b/gcc/ada/ChangeLog @@ -1,3 +1,91 @@ +2025-06-05 Javier Miranda + + * exp_ch7.adb (Process_Object_Declaration): Avoid generating + duplicate names for master nodes. + +2025-06-05 Steve Baird + + * sem_util.adb + (Side_Effect_Free_Statements): Return False if the statement list + includes an explicit (i.e. Comes_From_Source) raise statement. + +2025-06-05 Ronan Desplanques + + * exp_ch4.adb (Tagged_Membership): Fix for protected types. + +2025-06-05 Ronan Desplanques + + * exp_attr.adb (Interunit_Ref_OK): Tweak categorization of compilation + units. + +2025-06-05 Eric Botcazou + + * exp_aggr.adb (Build_Two_Pass_Aggr_Code): New function containing + most of the code initially present in Two_Pass_Aggregate_Expansion. + (Two_Pass_Aggregate_Expansion): Remove redundant N parameter. + Implement built-in-place expansion for (static) object declarations + and allocators, using Build_Two_Pass_Aggr_Code for the main work. + (Expand_Array_Aggregate): Adjust Two_Pass_Aggregate_Expansion call. + Replace Etype (N) by Typ in a couple of places. + * exp_ch3.adb (Expand_Freeze_Array_Type): Remove special case for + two-pass array aggregates. + (Expand_N_Object_Declaration): Do not adjust the object when it is + initialized by a two-pass array aggregate. + * exp_ch4.adb (Expand_Allocator_Expression): Apply the processing + used for container aggregates to two-pass array aggregates. + * exp_ch6.adb (Validate_Subprogram_Calls): Skip calls present in + initialization expressions of N_Object_Declaration nodes that have + No_Initialization set. + * sem_ch3.adb (Analyze_Object_Declaration): Detect the cases of an + array originally initialized by an aggregate consistently. + +2025-06-05 Viljar Indus + + * doc/gnat_rm/implementation_defined_attributes.rst: Update the + documentation for Valid_Value. + * sem_attr.adb (Analyze_Attribute): Reject types where + the root type originates from Standard. + * gnat_rm.texi: Regenerate. + +2025-06-05 Gary Dismukes + + * exp_aggr.adb (Two_Pass_Aggregate_Expansion): Change call to Make_Assignment + for the indexed aggregate object to call Change_Make_OK_Assignment instead. + +2025-06-05 Eric Botcazou + + * exp_ch6.adb (Expand_Actuals): Remove obsolete comment. + (Make_Build_In_Place_Call_In_Anonymous_Context): Always use a proper + object declaration initialized with the function call in the cases + where a temporary is needed, with Assignment_OK set on it. + * sem_util.adb (Entity_Of): Deal with rewritten function call first. + +2025-06-05 Steve Baird + + * exp_attr.adb (Expand_N_Attribute_Reference): When accessing the + maps declared in package Cached_Attribute_Ops, the key value + passed to Get or to Set should never be the entity node for a + subtype. Use the entity of the corresponding type declaration + instead. + +2025-06-05 Steve Baird + + * sem_res.adb + (Set_Mixed_Mode_Operand): If we are about to call Resolve + passing in Any_Fixed as the expected type, then instead pass in + the fixed point type of the other operand (i.e., B_Typ). + +2025-06-05 Gary Dismukes + + * sem_util.adb (Check_Function_Writable_Actuals): Add handling for + N_Iterated_Component_Association and N_Iterated_Element_Association. + Fix a typo in an RM reference (6.4.1(20/3) => 6.4.1(6.20/3)). + (Collect_Expression_Ids): New procedure factoring code for collecting + identifiers from expressions of aggregate associations. + (Handle_Association_Choices): New procedure factoring code for handling + id collection for expressions of aggregate associations with multiple + choices. Removed redundant test of Box_Present from original code. + 2025-05-05 Eric Botcazou PR ada/120104 diff --git a/gcc/testsuite/ChangeLog b/gcc/testsuite/ChangeLog index 0dc3767..1175523 100644 --- a/gcc/testsuite/ChangeLog +++ b/gcc/testsuite/ChangeLog @@ -1,3 +1,9 @@ +2025-06-05 Eric Botcazou + + * gnat.dg/specs/opt7.ads: New test. + * gnat.dg/specs/opt7_pkg.ads: New helper. + * gnat.dg/specs/opt7_pkg.adb: Likewise. + 2025-06-04 Harald Anlauf Backported from master: -- cgit v1.1 From e93f02828faf7dc0df6a4d67b1b6b2a30bd713cb Mon Sep 17 00:00:00 2001 From: Richard Biener Date: Wed, 14 May 2025 16:36:29 +0200 Subject: Fix regression from x86 multi-epilogue tuning With the avx512_two_epilogues tuning enabled for zen4 and zen5 the gcc.target/i386/vect-epilogues-5.c testcase below regresses and ends up using AVX2 sized vectors for the masked epilogue rather than AVX512 sized vectors. The following patch rectifies this and adds coverage for the intended behavior. * config/i386/i386.cc (ix86_vector_costs::finish_cost): Do not suggest a first epilogue mode for AVX512 sized main loops with X86_TUNE_AVX512_TWO_EPILOGUES as that interferes with using a masked epilogue. * gcc.target/i386/vect-epilogues-1.c: New testcase. * gcc.target/i386/vect-epilogues-2.c: Likewise. * gcc.target/i386/vect-epilogues-3.c: Likewise. * gcc.target/i386/vect-epilogues-4.c: Likewise. * gcc.target/i386/vect-epilogues-5.c: Likewise. (cherry picked from commit 75c7f90bfe6fa8e6c1a70b784e98a3412861646d) --- gcc/config/i386/i386.cc | 10 +++------- gcc/testsuite/gcc.target/i386/vect-epilogues-1.c | 14 ++++++++++++++ gcc/testsuite/gcc.target/i386/vect-epilogues-2.c | 15 +++++++++++++++ gcc/testsuite/gcc.target/i386/vect-epilogues-3.c | 15 +++++++++++++++ gcc/testsuite/gcc.target/i386/vect-epilogues-4.c | 13 +++++++++++++ gcc/testsuite/gcc.target/i386/vect-epilogues-5.c | 13 +++++++++++++ 6 files changed, 73 insertions(+), 7 deletions(-) create mode 100644 gcc/testsuite/gcc.target/i386/vect-epilogues-1.c create mode 100644 gcc/testsuite/gcc.target/i386/vect-epilogues-2.c create mode 100644 gcc/testsuite/gcc.target/i386/vect-epilogues-3.c create mode 100644 gcc/testsuite/gcc.target/i386/vect-epilogues-4.c create mode 100644 gcc/testsuite/gcc.target/i386/vect-epilogues-5.c (limited to 'gcc') diff --git a/gcc/config/i386/i386.cc b/gcc/config/i386/i386.cc index 38df84f..a6f0a58 100644 --- a/gcc/config/i386/i386.cc +++ b/gcc/config/i386/i386.cc @@ -25545,14 +25545,10 @@ ix86_vector_costs::finish_cost (const vector_costs *scalar_costs) /* When X86_TUNE_AVX512_TWO_EPILOGUES is enabled arrange for both a AVX2 and a SSE epilogue for AVX512 vectorized loops. */ if (loop_vinfo + && LOOP_VINFO_EPILOGUE_P (loop_vinfo) + && GET_MODE_SIZE (loop_vinfo->vector_mode) == 32 && ix86_tune_features[X86_TUNE_AVX512_TWO_EPILOGUES]) - { - if (GET_MODE_SIZE (loop_vinfo->vector_mode) == 64) - m_suggested_epilogue_mode = V32QImode; - else if (LOOP_VINFO_EPILOGUE_P (loop_vinfo) - && GET_MODE_SIZE (loop_vinfo->vector_mode) == 32) - m_suggested_epilogue_mode = V16QImode; - } + m_suggested_epilogue_mode = V16QImode; /* When a 128bit SSE vectorized epilogue still has a VF of 16 or larger enable a 64bit SSE epilogue. */ if (loop_vinfo diff --git a/gcc/testsuite/gcc.target/i386/vect-epilogues-1.c b/gcc/testsuite/gcc.target/i386/vect-epilogues-1.c new file mode 100644 index 0000000..a7f5f12 --- /dev/null +++ b/gcc/testsuite/gcc.target/i386/vect-epilogues-1.c @@ -0,0 +1,14 @@ +/* { dg-do compile } */ +/* { dg-options "-O3 -mavx2 -mno-avx512f -mtune=generic -fdump-tree-vect-optimized" } */ + +int test (signed char *data, int n) +{ + int sum = 0; + for (int i = 0; i < n; ++i) + sum += data[i]; + return sum; +} + +/* { dg-final { scan-tree-dump "loop vectorized using 32 byte vectors" "vect" } } */ +/* { dg-final { scan-tree-dump "loop vectorized using 16 byte vectors" "vect" } } */ +/* { dg-final { scan-tree-dump "loop vectorized using 8 byte vectors" "vect" { target { ! ia32 } } } } */ diff --git a/gcc/testsuite/gcc.target/i386/vect-epilogues-2.c b/gcc/testsuite/gcc.target/i386/vect-epilogues-2.c new file mode 100644 index 0000000..d6c06ed --- /dev/null +++ b/gcc/testsuite/gcc.target/i386/vect-epilogues-2.c @@ -0,0 +1,15 @@ +/* { dg-do compile } */ +/* { dg-options "-O3 -mavx512bw -mtune=generic -fdump-tree-vect-optimized" } */ + +int test (signed char *data, int n) +{ + int sum = 0; + for (int i = 0; i < n; ++i) + sum += data[i]; + return sum; +} + +/* { dg-final { scan-tree-dump "loop vectorized using 64 byte vectors" "vect" } } */ +/* { dg-final { scan-tree-dump "loop vectorized using 32 byte vectors" "vect" } } */ +/* { dg-final { scan-tree-dump-not "loop vectorized using 16 byte vectors" "vect" } } */ +/* { dg-final { scan-tree-dump-not "loop vectorized using 8 byte vectors" "vect" } } */ diff --git a/gcc/testsuite/gcc.target/i386/vect-epilogues-3.c b/gcc/testsuite/gcc.target/i386/vect-epilogues-3.c new file mode 100644 index 0000000..0ee610f --- /dev/null +++ b/gcc/testsuite/gcc.target/i386/vect-epilogues-3.c @@ -0,0 +1,15 @@ +/* { dg-do compile } */ +/* { dg-options "-O3 -mavx512bw -mtune=znver4 -fdump-tree-vect-optimized" } */ + +int test (signed char *data, int n) +{ + int sum = 0; + for (int i = 0; i < n; ++i) + sum += data[i]; + return sum; +} + +/* { dg-final { scan-tree-dump "loop vectorized using 64 byte vectors" "vect" } } */ +/* { dg-final { scan-tree-dump "loop vectorized using 32 byte vectors" "vect" } } */ +/* { dg-final { scan-tree-dump "loop vectorized using 16 byte vectors" "vect" } } */ +/* { dg-final { scan-tree-dump "loop vectorized using 8 byte vectors" "vect" { target { ! ia32 } } } } */ diff --git a/gcc/testsuite/gcc.target/i386/vect-epilogues-4.c b/gcc/testsuite/gcc.target/i386/vect-epilogues-4.c new file mode 100644 index 0000000..498db6b --- /dev/null +++ b/gcc/testsuite/gcc.target/i386/vect-epilogues-4.c @@ -0,0 +1,13 @@ +/* { dg-do compile } */ +/* { dg-options "-O3 -mavx512bw -mtune=generic --param vect-partial-vector-usage=1 -fdump-tree-vect-optimized" } */ + +int test (signed char *data, int n) +{ + int sum = 0; + for (int i = 0; i < n; ++i) + sum += data[i]; + return sum; +} + +/* { dg-final { scan-tree-dump-times "loop vectorized using 64 byte vectors" 2 "vect" } } */ +/* { dg-final { scan-tree-dump-not "loop vectorized using 32 byte vectors" "vect" } } */ diff --git a/gcc/testsuite/gcc.target/i386/vect-epilogues-5.c b/gcc/testsuite/gcc.target/i386/vect-epilogues-5.c new file mode 100644 index 0000000..6772cab --- /dev/null +++ b/gcc/testsuite/gcc.target/i386/vect-epilogues-5.c @@ -0,0 +1,13 @@ +/* { dg-do compile } */ +/* { dg-options "-O3 -mavx512bw -mtune=znver4 --param vect-partial-vector-usage=1 -fdump-tree-vect-optimized" } */ + +int test (signed char *data, int n) +{ + int sum = 0; + for (int i = 0; i < n; ++i) + sum += data[i]; + return sum; +} + +/* { dg-final { scan-tree-dump-times "loop vectorized using 64 byte vectors" 2 "vect" } } */ +/* { dg-final { scan-tree-dump-not "loop vectorized using 32 byte vectors" "vect" } } */ -- cgit v1.1 From 6bb316973249d460f4dae2c33a0aa5bc2928ef30 Mon Sep 17 00:00:00 2001 From: Richard Biener Date: Tue, 29 Apr 2025 14:52:27 +0200 Subject: tree-optimization/119960 - fix and guard get_later_stmt The following makes get_later_stmt handle stmts from different basic-blocks in the case they are orderd and otherwise asserts. * tree-vectorizer.h (get_later_stmt): Robustify against stmts in different BBs, assert when they are unordered. (cherry picked from commit a6cfde60d8c744b31b147022e797bbcc371ae092) --- gcc/tree-vectorizer.h | 20 +++++++++++++++++--- 1 file changed, 17 insertions(+), 3 deletions(-) (limited to 'gcc') diff --git a/gcc/tree-vectorizer.h b/gcc/tree-vectorizer.h index 01d19c7..94cbfde6 100644 --- a/gcc/tree-vectorizer.h +++ b/gcc/tree-vectorizer.h @@ -1870,11 +1870,25 @@ vect_orig_stmt (stmt_vec_info stmt_info) inline stmt_vec_info get_later_stmt (stmt_vec_info stmt1_info, stmt_vec_info stmt2_info) { - if (gimple_uid (vect_orig_stmt (stmt1_info)->stmt) - > gimple_uid (vect_orig_stmt (stmt2_info)->stmt)) + gimple *stmt1 = vect_orig_stmt (stmt1_info)->stmt; + gimple *stmt2 = vect_orig_stmt (stmt2_info)->stmt; + if (gimple_bb (stmt1) == gimple_bb (stmt2)) + { + if (gimple_uid (stmt1) > gimple_uid (stmt2)) + return stmt1_info; + else + return stmt2_info; + } + /* ??? We should be really calling this function only with stmts + in the same BB but we can recover if there's a domination + relationship between them. */ + else if (dominated_by_p (CDI_DOMINATORS, + gimple_bb (stmt1), gimple_bb (stmt2))) return stmt1_info; - else + else if (dominated_by_p (CDI_DOMINATORS, + gimple_bb (stmt2), gimple_bb (stmt1))) return stmt2_info; + gcc_unreachable (); } /* If STMT_INFO has been replaced by a pattern statement, return the -- cgit v1.1 From 05ef04d644c1a460b3af266a7766001c93fe1a6a Mon Sep 17 00:00:00 2001 From: Richard Biener Date: Tue, 29 Apr 2025 15:08:52 +0200 Subject: tree-optimization/119960 - add validity checking to SLP scheduling The following adds checks that when we search for a vector stmt insert location we arrive at one where all required operand defs are dominating the insert location. At the moment any such failure only blows up during SSA verification. There's the long-standing issue that we do not verify there exists a valid schedule of the SLP graph from BB vectorization into the existing CFG. We do not have the ability to insert vector stmts on the dominance frontier "end", nor to insert LC PHIs that would be eventually required. This should be done all differently, computing the schedule during analysis and failing if we can't schedule. PR tree-optimization/119960 * tree-vect-slp.cc (vect_schedule_slp_node): Sanity check dominance check on operand defs. (cherry picked from commit 5f44fcdfe18e72f2900d2757375843e88d32c535) --- gcc/tree-vect-slp.cc | 36 ++++++++++++++++++++++++++++-------- 1 file changed, 28 insertions(+), 8 deletions(-) (limited to 'gcc') diff --git a/gcc/tree-vect-slp.cc b/gcc/tree-vect-slp.cc index 958f000..ed432a9 100644 --- a/gcc/tree-vect-slp.cc +++ b/gcc/tree-vect-slp.cc @@ -11162,9 +11162,14 @@ vect_schedule_slp_node (vec_info *vinfo, == cycle_phi_info_type); gphi *phi = as_a (vect_find_last_scalar_stmt_in_slp (child)->stmt); - if (!last_stmt - || vect_stmt_dominates_stmt_p (last_stmt, phi)) + if (!last_stmt) last_stmt = phi; + else if (vect_stmt_dominates_stmt_p (last_stmt, phi)) + last_stmt = phi; + else if (vect_stmt_dominates_stmt_p (phi, last_stmt)) + ; + else + gcc_unreachable (); } /* We are emitting all vectorized stmts in the same place and the last one is the last. @@ -11175,9 +11180,14 @@ vect_schedule_slp_node (vec_info *vinfo, FOR_EACH_VEC_ELT (SLP_TREE_VEC_DEFS (child), j, vdef) { gimple *vstmt = SSA_NAME_DEF_STMT (vdef); - if (!last_stmt - || vect_stmt_dominates_stmt_p (last_stmt, vstmt)) + if (!last_stmt) + last_stmt = vstmt; + else if (vect_stmt_dominates_stmt_p (last_stmt, vstmt)) last_stmt = vstmt; + else if (vect_stmt_dominates_stmt_p (vstmt, last_stmt)) + ; + else + gcc_unreachable (); } } else if (!SLP_TREE_VECTYPE (child)) @@ -11190,9 +11200,14 @@ vect_schedule_slp_node (vec_info *vinfo, && !SSA_NAME_IS_DEFAULT_DEF (def)) { gimple *stmt = SSA_NAME_DEF_STMT (def); - if (!last_stmt - || vect_stmt_dominates_stmt_p (last_stmt, stmt)) + if (!last_stmt) + last_stmt = stmt; + else if (vect_stmt_dominates_stmt_p (last_stmt, stmt)) last_stmt = stmt; + else if (vect_stmt_dominates_stmt_p (stmt, last_stmt)) + ; + else + gcc_unreachable (); } } else @@ -11213,9 +11228,14 @@ vect_schedule_slp_node (vec_info *vinfo, && !SSA_NAME_IS_DEFAULT_DEF (vdef)) { gimple *vstmt = SSA_NAME_DEF_STMT (vdef); - if (!last_stmt - || vect_stmt_dominates_stmt_p (last_stmt, vstmt)) + if (!last_stmt) + last_stmt = vstmt; + else if (vect_stmt_dominates_stmt_p (last_stmt, vstmt)) last_stmt = vstmt; + else if (vect_stmt_dominates_stmt_p (vstmt, last_stmt)) + ; + else + gcc_unreachable (); } } } -- cgit v1.1 From 7da2b6ddf3a8371b585595231cddcb1ad0942ea4 Mon Sep 17 00:00:00 2001 From: Richard Biener Date: Thu, 8 May 2025 10:56:16 +0200 Subject: tree-optimization/116352 - amend previous fix The previous fix restricted external vector builds to defs from the same basic-block. That turns out too restrictive so we have to mitigate the original issue in a different way which is restricting it to the original case where all defs are in the same basic-block. PR tree-optimization/116352 * tree-vect-slp.cc (vect_build_slp_tree_2): When compressing operands from a two-operator node make sure the resulting operation does not mix defs from different basic-blocks. (cherry picked from commit 1e8bd720b1a618a39e2a41eec05e935c32d295f3) --- gcc/tree-vect-slp.cc | 11 ++++++++++- 1 file changed, 10 insertions(+), 1 deletion(-) (limited to 'gcc') diff --git a/gcc/tree-vect-slp.cc b/gcc/tree-vect-slp.cc index ed432a9..b5addd6 100644 --- a/gcc/tree-vect-slp.cc +++ b/gcc/tree-vect-slp.cc @@ -2616,13 +2616,14 @@ out: if (oprnds_info[0]->def_stmts[0] && is_a (oprnds_info[0]->def_stmts[0]->stmt)) code = gimple_assign_rhs_code (oprnds_info[0]->def_stmts[0]->stmt); + basic_block bb = nullptr; for (unsigned j = 0; j < group_size; ++j) { FOR_EACH_VEC_ELT (oprnds_info, i, oprnd_info) { stmt_vec_info stmt_info = oprnd_info->def_stmts[j]; - if (!stmt_info || !stmt_info->stmt + if (!stmt_info || !is_a (stmt_info->stmt) || gimple_assign_rhs_code (stmt_info->stmt) != code || skip_args[i]) @@ -2630,6 +2631,14 @@ out: success = false; break; } + /* Avoid mixing lanes with defs in different basic-blocks. */ + if (!bb) + bb = gimple_bb (vect_orig_stmt (stmt_info)->stmt); + else if (gimple_bb (vect_orig_stmt (stmt_info)->stmt) != bb) + { + success = false; + break; + } bool exists; unsigned &stmt_idx -- cgit v1.1 From 8fb3d9066266ea30de62c395239bda4e992297a3 Mon Sep 17 00:00:00 2001 From: Richard Biener Date: Tue, 29 Apr 2025 13:23:41 +0200 Subject: tree-optimization/119960 - failed external SLP promotion The following addresses a too conservative sanity check of SLP nodes we want to promote external. The issue lies in code generation for such external which relies on get_later_stmt to figure an insert location. But get_later_stmt relies on the ability to totally order stmts, specifically implementation-wise that they are all from the same BB, which is what is verified at the moment. The patch changes this to require stmts to be orderable by dominance queries. For simplicity and seemingly enough for the testcase in PR119960, this handles the case of two distinct BBs. PR tree-optimization/119960 * tree-vect-slp.cc (vect_slp_can_convert_to_external): Handle cases where defs from multiple BBs are ordered by their dominance relation. * gcc.dg/vect/bb-slp-pr119960-1.c: New testcase. (cherry picked from commit cc74e2f2b39b6debbef1787a087abad2108e95dd) --- gcc/testsuite/gcc.dg/vect/bb-slp-pr119960-1.c | 15 +++++++ gcc/tree-vect-slp.cc | 63 ++++++++++++++++++++++++--- 2 files changed, 71 insertions(+), 7 deletions(-) create mode 100644 gcc/testsuite/gcc.dg/vect/bb-slp-pr119960-1.c (limited to 'gcc') diff --git a/gcc/testsuite/gcc.dg/vect/bb-slp-pr119960-1.c b/gcc/testsuite/gcc.dg/vect/bb-slp-pr119960-1.c new file mode 100644 index 0000000..955fc7e --- /dev/null +++ b/gcc/testsuite/gcc.dg/vect/bb-slp-pr119960-1.c @@ -0,0 +1,15 @@ +/* { dg-do compile } */ +/* { dg-require-effective-target vect_double } */ + +double foo (double *dst, double *src, int b) +{ + double y = src[1]; + if (b) + { + dst[0] = src[0]; + dst[1] = y; + } + return y; +} + +/* { dg-final { scan-tree-dump "optimized: basic block part vectorized" "slp2" { target vect_double } } } */ diff --git a/gcc/tree-vect-slp.cc b/gcc/tree-vect-slp.cc index b5addd6..f5286e6 100644 --- a/gcc/tree-vect-slp.cc +++ b/gcc/tree-vect-slp.cc @@ -7842,21 +7842,70 @@ vect_slp_analyze_node_operations_1 (vec_info *vinfo, slp_tree node, node, node_instance, cost_vec); } +static int +sort_ints (const void *a_, const void *b_) +{ + int a = *(const int *)a_; + int b = *(const int *)b_; + return a - b; +} + /* Verify if we can externalize a set of internal defs. */ static bool vect_slp_can_convert_to_external (const vec &stmts) { + /* Constant generation uses get_later_stmt which can only handle + defs from the same BB or a set of defs that can be ordered + with a dominance query. */ basic_block bb = NULL; + bool all_same = true; + auto_vec bbs; + bbs.reserve_exact (stmts.length ()); for (stmt_vec_info stmt : stmts) - if (!stmt) - return false; - /* Constant generation uses get_later_stmt which can only handle - defs from the same BB. */ - else if (!bb) - bb = gimple_bb (stmt->stmt); - else if (gimple_bb (stmt->stmt) != bb) + { + if (!stmt) + return false; + else if (!bb) + bb = gimple_bb (stmt->stmt); + else if (gimple_bb (stmt->stmt) != bb) + all_same = false; + bbs.quick_push (gimple_bb (stmt->stmt)->index); + } + if (all_same) + return true; + + /* Produce a vector of unique BB indexes for the defs. */ + bbs.qsort (sort_ints); + unsigned i, j; + for (i = 1, j = 1; i < bbs.length (); ++i) + if (bbs[i] != bbs[j-1]) + bbs[j++] = bbs[i]; + gcc_assert (j >= 2); + bbs.truncate (j); + + if (bbs.length () == 2) + return (dominated_by_p (CDI_DOMINATORS, + BASIC_BLOCK_FOR_FN (cfun, bbs[0]), + BASIC_BLOCK_FOR_FN (cfun, bbs[1])) + || dominated_by_p (CDI_DOMINATORS, + BASIC_BLOCK_FOR_FN (cfun, bbs[1]), + BASIC_BLOCK_FOR_FN (cfun, bbs[0]))); + + /* ??? For more than two BBs we can sort the vector and verify the + result is a total order. But we can't use vec::qsort with a + compare function using a dominance query since there's no way to + signal failure and any fallback for an unordered pair would + fail qsort_chk later. + For now simply hope that ordering after BB index provides the + best candidate total order. If required we can implement our + own mergesort or export an entry without checking. */ + for (unsigned i = 1; i < bbs.length (); ++i) + if (!dominated_by_p (CDI_DOMINATORS, + BASIC_BLOCK_FOR_FN (cfun, bbs[i]), + BASIC_BLOCK_FOR_FN (cfun, bbs[i-1]))) return false; + return true; } -- cgit v1.1 From 4d375ebd56c54dc8c242bed988f29094b7e3e94e Mon Sep 17 00:00:00 2001 From: Richard Biener Date: Wed, 30 Apr 2025 11:52:17 +0200 Subject: tree-optimization/120003 - missed jump threading The following allows the entry and exit block of a jump thread path to be equal, which can easily happen when there isn't a forwarder on the interesting edge for an FSM thread conditional. We just don't want to enlarge the path from such a block. PR tree-optimization/120003 * tree-ssa-threadbackward.cc (back_threader::find_paths_to_names): Allow block re-use but do not enlarge the path beyond such a re-use. * gcc.dg/tree-ssa/ssa-thread-23.c: New testcase. * gcc.dg/tree-ssa/ssa-dom-thread-7.c: Adjust. (cherry picked from commit 1a13684dfc7286139064f7d7341462c9995cbd1c) --- gcc/testsuite/gcc.dg/tree-ssa/ssa-dom-thread-7.c | 4 ++-- gcc/testsuite/gcc.dg/tree-ssa/ssa-thread-23.c | 19 +++++++++++++++++++ gcc/tree-ssa-threadbackward.cc | 8 +++----- 3 files changed, 24 insertions(+), 7 deletions(-) create mode 100644 gcc/testsuite/gcc.dg/tree-ssa/ssa-thread-23.c (limited to 'gcc') diff --git a/gcc/testsuite/gcc.dg/tree-ssa/ssa-dom-thread-7.c b/gcc/testsuite/gcc.dg/tree-ssa/ssa-dom-thread-7.c index d84acee..8be9878 100644 --- a/gcc/testsuite/gcc.dg/tree-ssa/ssa-dom-thread-7.c +++ b/gcc/testsuite/gcc.dg/tree-ssa/ssa-dom-thread-7.c @@ -11,8 +11,8 @@ to change decisions in switch expansion which in turn can expose new jump threading opportunities. Skip the later tests on aarch64. */ /* { dg-final { scan-tree-dump-not "Jumps threaded" "dom3" { target { ! aarch64*-*-* } } } } */ -/* { dg-final { scan-tree-dump "Jumps threaded: 9" "thread2" { target { ! aarch64*-*-* } } } } */ -/* { dg-final { scan-tree-dump "Jumps threaded: 17" "thread2" { target { aarch64*-*-* } } } } */ +/* { dg-final { scan-tree-dump "Jumps threaded: 10" "thread2" { target { ! aarch64*-*-* } } } } */ +/* { dg-final { scan-tree-dump "Jumps threaded: 14" "thread2" { target { aarch64*-*-* } } } } */ enum STATE { S0=0, diff --git a/gcc/testsuite/gcc.dg/tree-ssa/ssa-thread-23.c b/gcc/testsuite/gcc.dg/tree-ssa/ssa-thread-23.c new file mode 100644 index 0000000..930360a --- /dev/null +++ b/gcc/testsuite/gcc.dg/tree-ssa/ssa-thread-23.c @@ -0,0 +1,19 @@ +/* PR120003 */ +/* { dg-do compile } */ +/* { dg-options "-O2 -fdump-tree-cddce3-details" } */ + +extern _Bool g(int); + +_Bool f() +{ + _Bool retval = 0; + for(int i=0; i<1000000; ++i) + retval = retval || g(i); + return retval; +} + +/* Jump threading after loop optimization should get the counting loop + separated from the loop until retval is true and CD-DCE elide it. + It's difficult to check for the fact that a true retval terminates + the loop so check CD-DCE eliminates one loop instead. */ +/* { dg-final { scan-tree-dump "fix_loop_structure: removing loop" "cddce3" } } */ diff --git a/gcc/tree-ssa-threadbackward.cc b/gcc/tree-ssa-threadbackward.cc index d0b74b2..3adb83e 100644 --- a/gcc/tree-ssa-threadbackward.cc +++ b/gcc/tree-ssa-threadbackward.cc @@ -349,9 +349,6 @@ back_threader::find_paths_to_names (basic_block bb, bitmap interesting, unsigned overall_paths, back_threader_profitability &profit) { - if (m_visited_bbs.add (bb)) - return; - m_path.safe_push (bb); // Try to resolve the path without looking back. Avoid resolving paths @@ -377,7 +374,8 @@ back_threader::find_paths_to_names (basic_block bb, bitmap interesting, // Continue looking for ways to extend the path but limit the // search space along a branch else if ((overall_paths = overall_paths * EDGE_COUNT (bb->preds)) - <= (unsigned)param_max_jump_thread_paths) + <= (unsigned)param_max_jump_thread_paths + && !m_visited_bbs.add (bb)) { // For further greedy searching we want to remove interesting // names defined in BB but add ones on the PHI edges for the @@ -489,6 +487,7 @@ back_threader::find_paths_to_names (basic_block bb, bitmap interesting, backtracking we have to restore it. */ for (int j : new_imports) bitmap_clear_bit (m_imports, j); + m_visited_bbs.remove (bb); } else if (dump_file && (dump_flags & TDF_DETAILS)) fprintf (dump_file, " FAIL: Search space limit %d reached.\n", @@ -496,7 +495,6 @@ back_threader::find_paths_to_names (basic_block bb, bitmap interesting, // Reset things to their original state. m_path.pop (); - m_visited_bbs.remove (bb); } // Search backwards from BB looking for paths where the final -- cgit v1.1 From ca8032d6177668ca7f2a6a2e612e126a97ba8c53 Mon Sep 17 00:00:00 2001 From: Richard Biener Date: Thu, 1 May 2025 13:56:25 +0200 Subject: Fix gcc.dg/tree-ssa/ssa-dom-thread-7.c for aarch64 So on another machine with a cross I see 17 jumps threaded, so adjusted like that. PR tree-optimization/120003 * gcc.dg/tree-ssa/ssa-dom-thread-7.c: Adjust aarch64 expected thread2 number of threads. (cherry picked from commit aa6f1df4ec46a20d2292291b192d3331e51b59f8) --- gcc/testsuite/gcc.dg/tree-ssa/ssa-dom-thread-7.c | 2 +- 1 file changed, 1 insertion(+), 1 deletion(-) (limited to 'gcc') diff --git a/gcc/testsuite/gcc.dg/tree-ssa/ssa-dom-thread-7.c b/gcc/testsuite/gcc.dg/tree-ssa/ssa-dom-thread-7.c index 8be9878..59891f2 100644 --- a/gcc/testsuite/gcc.dg/tree-ssa/ssa-dom-thread-7.c +++ b/gcc/testsuite/gcc.dg/tree-ssa/ssa-dom-thread-7.c @@ -12,7 +12,7 @@ jump threading opportunities. Skip the later tests on aarch64. */ /* { dg-final { scan-tree-dump-not "Jumps threaded" "dom3" { target { ! aarch64*-*-* } } } } */ /* { dg-final { scan-tree-dump "Jumps threaded: 10" "thread2" { target { ! aarch64*-*-* } } } } */ -/* { dg-final { scan-tree-dump "Jumps threaded: 14" "thread2" { target { aarch64*-*-* } } } } */ +/* { dg-final { scan-tree-dump "Jumps threaded: 17" "thread2" { target { aarch64*-*-* } } } } */ enum STATE { S0=0, -- cgit v1.1 From 44792a6c4253f9a5b322797ef73b9c347c223545 Mon Sep 17 00:00:00 2001 From: Richard Biener Date: Fri, 9 May 2025 08:38:45 +0200 Subject: rtl-optimization/120182 - wrong-code with RTL DSE and constant addresses RTL DSE forms store groups from unique invariant bases but that is confused when presented with constant addresses where it assigns one store group per unique address. That causes it to not consider 0x101:QI to alias 0x100:SI. Constant accesses can really alias to every object, in practice they appear for I/O and for access to objects fixed via linker scripts for example. So simply avoid registering a store group for them. PR rtl-optimization/120182 * dse.cc (canon_address): Constant addresses have no separate store group. * gcc.dg/torture/pr120182.c: New testcase. (cherry picked from commit b9434c3db900d5d037fdf2f64149b82800ceadf8) --- gcc/dse.cc | 5 +++- gcc/testsuite/gcc.dg/torture/pr120182.c | 42 +++++++++++++++++++++++++++++++++ 2 files changed, 46 insertions(+), 1 deletion(-) create mode 100644 gcc/testsuite/gcc.dg/torture/pr120182.c (limited to 'gcc') diff --git a/gcc/dse.cc b/gcc/dse.cc index ffc86ff..14f82c3 100644 --- a/gcc/dse.cc +++ b/gcc/dse.cc @@ -1190,7 +1190,10 @@ canon_address (rtx mem, address = strip_offset_and_add (address, offset); if (ADDR_SPACE_GENERIC_P (MEM_ADDR_SPACE (mem)) - && const_or_frame_p (address)) + && const_or_frame_p (address) + /* Literal addresses can alias any base, avoid creating a + group for them. */ + && ! CONST_SCALAR_INT_P (address)) { group_info *group = get_group_info (address); diff --git a/gcc/testsuite/gcc.dg/torture/pr120182.c b/gcc/testsuite/gcc.dg/torture/pr120182.c new file mode 100644 index 0000000..5e2d171 --- /dev/null +++ b/gcc/testsuite/gcc.dg/torture/pr120182.c @@ -0,0 +1,42 @@ +/* { dg-do run { target { { *-*-linux* *-*-gnu* *-*-uclinux* } && mmap } } } */ + +#include +#include +#include + +struct S +{ + struct S *next; +}; + +static void __attribute__((noipa)) +allocate(void *addr, unsigned long long size) +{ + void *ptr = mmap((void *)addr, size, + PROT_READ | PROT_WRITE, + MAP_PRIVATE | MAP_ANONYMOUS | MAP_FIXED_NOREPLACE, + -1, 0); + if(ptr != addr) + exit(0); +} + +int main (void) +{ + int size = 0x8000; + char *ptr = (char *)0x288000ull; + allocate((void *)ptr, size); + + struct S *s1 = (struct S *)ptr; + struct S *s2 = (struct S *)256; + for (int i = 0; i < 3; i++) + { + for(char *addr = (char *)s1; addr < (char *)s1 + sizeof(*s1); ++addr) + *addr = 0; + + if(s1->next) + s1->next = s1->next->next = s2; + else + s1->next = s2; + } + return 0; +} -- cgit v1.1 From 09884fa0f90da67915245622254cdfb947b87d37 Mon Sep 17 00:00:00 2001 From: Richard Biener Date: Fri, 30 May 2025 13:47:55 +0200 Subject: tree-optimization/120341 - stores into STRING_CSTs can trap The following fixes conditional store elimination and store motion so they consider stores to STRING_CSTs as trapping. PR tree-optimization/120341 * tree-ssa-loop-im.cc (can_sm_ref_p): STRING_CSTs are readonly. * tree-ssa-phiopt.cc (cond_store_replacement): Likewise. * gcc.dg/torture/pr120341-1.c: New testcase. * gcc.dg/torture/pr120341-2.c: Likewise. (cherry picked from commit 02c58bc4b0885f5b6f50033da35768ebe6c4a030) --- gcc/testsuite/gcc.dg/torture/pr120341-1.c | 11 +++++++++++ gcc/testsuite/gcc.dg/torture/pr120341-2.c | 13 +++++++++++++ gcc/tree-ssa-loop-im.cc | 3 ++- gcc/tree-ssa-phiopt.cc | 5 +++-- 4 files changed, 29 insertions(+), 3 deletions(-) create mode 100644 gcc/testsuite/gcc.dg/torture/pr120341-1.c create mode 100644 gcc/testsuite/gcc.dg/torture/pr120341-2.c (limited to 'gcc') diff --git a/gcc/testsuite/gcc.dg/torture/pr120341-1.c b/gcc/testsuite/gcc.dg/torture/pr120341-1.c new file mode 100644 index 0000000..e23185b --- /dev/null +++ b/gcc/testsuite/gcc.dg/torture/pr120341-1.c @@ -0,0 +1,11 @@ +/* { dg-do run } */ +/* { dg-additional-options "-fallow-store-data-races" } */ + +char a, *b; +int main() +{ + b = "0"; + if (a) + b[0]++; + return 0; +} diff --git a/gcc/testsuite/gcc.dg/torture/pr120341-2.c b/gcc/testsuite/gcc.dg/torture/pr120341-2.c new file mode 100644 index 0000000..7bcc96f --- /dev/null +++ b/gcc/testsuite/gcc.dg/torture/pr120341-2.c @@ -0,0 +1,13 @@ +/* { dg-do run } */ +/* { dg-additional-options "-fallow-store-data-races" } */ + +char a, *b; +int main() +{ + while (a) + { + b = "0"; + b[0]++; + } + return 0; +} diff --git a/gcc/tree-ssa-loop-im.cc b/gcc/tree-ssa-loop-im.cc index 225964c..71a46f7 100644 --- a/gcc/tree-ssa-loop-im.cc +++ b/gcc/tree-ssa-loop-im.cc @@ -3293,7 +3293,8 @@ can_sm_ref_p (class loop *loop, im_mem_ref *ref) explicitly. */ base = get_base_address (ref->mem.ref); if ((tree_could_trap_p (ref->mem.ref) - || (DECL_P (base) && TREE_READONLY (base))) + || (DECL_P (base) && TREE_READONLY (base)) + || TREE_CODE (base) == STRING_CST) /* ??? We can at least use false here, allowing loads? We are forcing conditional stores if the ref is not always stored to later anyway. So this would only guard diff --git a/gcc/tree-ssa-phiopt.cc b/gcc/tree-ssa-phiopt.cc index 7f3390b..aaebae6 100644 --- a/gcc/tree-ssa-phiopt.cc +++ b/gcc/tree-ssa-phiopt.cc @@ -3565,8 +3565,9 @@ cond_store_replacement (basic_block middle_bb, basic_block join_bb, /* tree_could_trap_p is a predicate for rvalues, so check for readonly memory explicitly. */ || ((base = get_base_address (lhs)) - && DECL_P (base) - && TREE_READONLY (base))) + && ((DECL_P (base) + && TREE_READONLY (base)) + || TREE_CODE (base) == STRING_CST))) return false; } -- cgit v1.1 From 8cb0127dfd3d01d4549f3139b087d1a5966844ee Mon Sep 17 00:00:00 2001 From: Richard Biener Date: Fri, 30 May 2025 14:11:47 +0200 Subject: tree-optimization/120357 - ICE with early break vectorization When doing early break vectorization of a loop with a conditional reduction the epilog creation code is confused as to before which exit to insert the conditional reduction induction IV update. The following make sure this is done before the main IV exit. PR tree-optimization/120357 * tree-vect-loop.cc (vect_create_epilog_for_reduction): Create the conditional reduction induction IV increment before the main IV exit. * gcc.dg/vect/vect-early-break_136-pr120357.c: New testcase. (cherry picked from commit dce4da51ab66c3abb84448326910cd42f6fe2499) --- gcc/testsuite/gcc.dg/vect/vect-early-break_136-pr120357.c | 13 +++++++++++++ gcc/tree-vect-loop.cc | 3 ++- 2 files changed, 15 insertions(+), 1 deletion(-) create mode 100644 gcc/testsuite/gcc.dg/vect/vect-early-break_136-pr120357.c (limited to 'gcc') diff --git a/gcc/testsuite/gcc.dg/vect/vect-early-break_136-pr120357.c b/gcc/testsuite/gcc.dg/vect/vect-early-break_136-pr120357.c new file mode 100644 index 0000000..8a51cfc --- /dev/null +++ b/gcc/testsuite/gcc.dg/vect/vect-early-break_136-pr120357.c @@ -0,0 +1,13 @@ +/* { dg-do compile } */ +/* { dg-add-options vect_early_break } */ +/* { dg-additional-options "-O3" } */ + +char a; +unsigned long long t[2][22]; +int u[22]; +void f(void) +{ + for (int v = 0; v < 22; v++) + for (_Bool w = 0; w < (u[v] < 0) + 1; w = 1) + a *= 0 != t[w][v]; +} diff --git a/gcc/tree-vect-loop.cc b/gcc/tree-vect-loop.cc index 2d35fa1..c824b5a 100644 --- a/gcc/tree-vect-loop.cc +++ b/gcc/tree-vect-loop.cc @@ -6189,7 +6189,8 @@ vect_create_epilog_for_reduction (loop_vec_info loop_vinfo, /* Create an induction variable. */ gimple_stmt_iterator incr_gsi; bool insert_after; - vect_iv_increment_position (loop_exit, &incr_gsi, &insert_after); + vect_iv_increment_position (LOOP_VINFO_IV_EXIT (loop_vinfo), + &incr_gsi, &insert_after); create_iv (series_vect, PLUS_EXPR, vec_step, NULL_TREE, loop, &incr_gsi, insert_after, &indx_before_incr, &indx_after_incr); -- cgit v1.1 From a69ab79c1abaa43f827a6ce1dacdcd78cf682cc8 Mon Sep 17 00:00:00 2001 From: Tobias Burnus Date: Thu, 5 Jun 2025 10:36:21 +0200 Subject: gcn: Update --with-arch= for newer archs Replace hard-coded list of supported devices by directly checking config/gcn/gcn-devices.def. gcc/ChangeLog: * config.gcc (--with-{arch,tune}): Use .def file to validate gcn processor names. * doc/install.texi (amdgcn*-*-*): Update list of devices supported by --with-arch/--with-tune. (cherry picked from commit 61a6430cf663e3c980c2ee966f094fea7d99f8e7) --- gcc/config.gcc | 12 +++++------- gcc/doc/install.texi | 10 +++++++--- 2 files changed, 12 insertions(+), 10 deletions(-) (limited to 'gcc') diff --git a/gcc/config.gcc b/gcc/config.gcc index 40b50dc..5725704 100644 --- a/gcc/config.gcc +++ b/gcc/config.gcc @@ -4598,15 +4598,13 @@ case "${target}" in for which in arch tune; do eval "val=\$with_$which" - case ${val} in - "" | gfx900 | gfx906 | gfx908 | gfx90a | gfx90c | gfx1030 | gfx1036 | gfx1100 | gfx1103) - # OK - ;; - *) + if test x"$val" != x \ + && ! grep -q "GCN_DEVICE($val," \ + "${srcdir}/config/gcn/gcn-devices.def"; + then echo "Unknown cpu used in --with-$which=$val." 1>&2 exit 1 - ;; - esac + fi done [ "x$with_arch" = x ] && with_arch=gfx900 diff --git a/gcc/doc/install.texi b/gcc/doc/install.texi index 1af0082..3e9e09b 100644 --- a/gcc/doc/install.texi +++ b/gcc/doc/install.texi @@ -1342,9 +1342,13 @@ default set of libraries is selected based on the value of @item amdgcn*-*-* @var{list} is a comma separated list of ISA names (allowed values: -@code{gfx900}, @code{gfx906}, @code{gfx908}, @code{gfx90a}, @code{gfx90c}, -@code{gfx1030}, @code{gfx1036}, @code{gfx1100}, @code{gfx1103}). -It ought not include the name of the default +@code{gfx900}, @code{gfx902}, @code{gfx904}, @code{gfx906}, @code{gfx908}, +@code{gfx909}, @code{gfx90a}, @code{gfx90c}, @code{gfx9-generic}, +@code{gfx1030}, @code{gfx1031}, @code{gfx1032}, @code{gfx1033}, +@code{gfx1034}, @code{gfx1035}, @code{gfx1036}, @code{gfx10-3-generic}, +@code{gfx1100}, @code{gfx1101}, @code{gfx1102}, @code{gfx1103}, +@code{gfx1150}, @code{gfx1151}, @code{gfx1152}, @code{gfx1153}, +@code{gfx11-generic}). It ought not include the name of the default ISA, specified via @option{--with-arch}. If @var{list} is empty, then there will be no multilibs and only the default run-time library will be built. If @var{list} is @code{default} or @option{--with-multilib-list=} is not -- cgit v1.1