https://gcc.gnu.org/g:30bc7cad47a385130623fcb10e22194be64409c6
commit 30bc7cad47a385130623fcb10e22194be64409c6
Author: Mikael Morin <mik...@gcc.gnu.org>
Date: Sat Aug 16 19:16:15 2025 +0200
Refactor set_dimension_fields descriptor_init_count
Correction régression class_allocate_22
Ajout scan tree var
Correction dumps coarray_12
Diff:
---
gcc/fortran/trans-descriptor.cc | 18 +++---------
gcc/testsuite/gfortran.dg/coarray_12.f90 | 3 +-
gcc/testsuite/lib/scandump.exp | 50 ++++++++++++++++++++++++++++++++
gcc/testsuite/lib/scantree.exp | 26 +++++++++++++++++
4 files changed, 82 insertions(+), 15 deletions(-)
diff --git a/gcc/fortran/trans-descriptor.cc b/gcc/fortran/trans-descriptor.cc
index 071840f0e871..1b08120e74a3 100644
--- a/gcc/fortran/trans-descriptor.cc
+++ b/gcc/fortran/trans-descriptor.cc
@@ -2816,15 +2816,8 @@ gfc_descriptor_init_count (tree descriptor, int rank,
int corank,
ubound = lower[n];
}
}
- gfc_conv_descriptor_lbound_set (descriptor_block, descriptor,
- gfc_rank_cst[n], se.expr);
conv_lbound = se.expr;
-
- /* Work out the offset for this component. */
- tmp = fold_build2_loc (input_location, MULT_EXPR, gfc_array_index_type,
- se.expr, stride);
- offset = fold_build2_loc (input_location, MINUS_EXPR,
- gfc_array_index_type, offset, tmp);
+ conv_lbound = gfc_evaluate_now (conv_lbound, pblock);
/* Set upper bound. */
gfc_init_se (&se, NULL);
@@ -2860,13 +2853,11 @@ gfc_descriptor_init_count (tree descriptor, int rank,
int corank,
if (ubound->expr_type == EXPR_FUNCTION)
se.expr = gfc_evaluate_now (se.expr, pblock);
}
- gfc_conv_descriptor_ubound_set (descriptor_block, descriptor,
- gfc_rank_cst[n], se.expr);
conv_ubound = se.expr;
+ conv_ubound = gfc_evaluate_now (conv_ubound, pblock);
- /* Store the stride. */
- gfc_conv_descriptor_stride_set (descriptor_block, descriptor,
- gfc_rank_cst[n], stride);
+ set_dimension_fields (descriptor_block, descriptor, gfc_rank_cst[n],
+ conv_lbound, conv_ubound, stride, &offset);
/* Calculate size and check whether extent is negative. */
size = gfc_conv_array_extent_dim (conv_lbound, conv_ubound, &empty_cond);
@@ -2950,7 +2941,6 @@ gfc_descriptor_init_count (tree descriptor, int rank, int
corank,
return gfc_index_one_node;
/* Update the array descriptor with the offset and the span. */
- offset = gfc_evaluate_now (offset, pblock);
gfc_conv_descriptor_offset_set (descriptor_block, descriptor, offset);
tmp = fold_convert (gfc_array_index_type, element_size);
gfc_conv_descriptor_span_set (descriptor_block, descriptor, tmp);
diff --git a/gcc/testsuite/gfortran.dg/coarray_12.f90
b/gcc/testsuite/gfortran.dg/coarray_12.f90
index 70efaaff5160..9bbb9e3a3035 100644
--- a/gcc/testsuite/gfortran.dg/coarray_12.f90
+++ b/gcc/testsuite/gfortran.dg/coarray_12.f90
@@ -46,7 +46,8 @@ end subroutine testAlloc5
! { dg-final { scan-tree-dump-times "a.dim.0..lbound = 1;" 1 "original" } }
-! { dg-final { scan-tree-dump-times "a.dim.0..ubound = .*nn;" 1 "original" } }
+! { dg-final { global ubound_value; scan-tree-dump-var {a\.dim\[0\]\.ubound =
(D\.\d+);} "original" "ubound_value" } }
+! { dg-final { global ubound_value; scan-tree-dump-times "$ubound_value =
.*nn;" 1 "original" } }
! { dg-final { scan-tree-dump-times "a.dim.1..lbound = 1;" 1 "original" } }
! { dg-final { scan-tree-dump-times "a.dim.1..ubound = .*mm;" 1 "original" } }
! { dg-final { scan-tree-dump-times "a.dim.2..lbound = 1;" 1 "original" } }
diff --git a/gcc/testsuite/lib/scandump.exp b/gcc/testsuite/lib/scandump.exp
index a8441daa22fa..74a77f0a57e1 100644
--- a/gcc/testsuite/lib/scandump.exp
+++ b/gcc/testsuite/lib/scandump.exp
@@ -214,6 +214,56 @@ proc scan-dump-not { args } {
}
}
+# Utility for scanning compiler result, invoked via dg-final.
+# Call pass if pattern is present, otherwise fail.
+#
+# Argument 0 is the type of dump we are searching (rtl, tree, ipa)
+# Argument 1 is the regexp to match.
+# Argument 2 is the suffix for the dump file
+# Argument 3 is the suffix of the dump base
+# Argument 4 is the variable name to store the matched content
+# Argument 5 handles expected failures and the like
+proc scan-dump-var { args } {
+
+ if { [llength $args] >= 6 } {
+ switch [dg-process-target [lindex $args 5]] {
+ "S" { }
+ "N" { return }
+ "F" { setup_xfail "*-*-*" }
+ "P" { }
+ }
+ }
+
+ set testcase [testname-for-summary]
+ # The name might include a list of options; extract the file name.
+ set filename [lindex $testcase 0]
+
+ set printable_pattern [make_pattern_printable [lindex $args 1]]
+ set suf [dump-suffix [lindex $args 2]]
+ set testname "$testcase scan-[lindex $args 0]-dump $suf
\"$printable_pattern\""
+ set src [file tail $filename]
+ set dumpbase [dump-base $src [lindex $args 3]]
+
+ set pattern "$dumpbase.[lindex $args 2]"
+ set output_file "[glob-dump-file $testcase $pattern]"
+ if { $output_file == "" } {
+ unresolved "$testname"
+ return
+ }
+
+ set fd [open $output_file r]
+ set text [read $fd]
+ close $fd
+
+ global [lindex $args 4]
+ set [lindex $args 4] {}
+ if [regexp -- [lindex $args 1] $text scratch [lindex $args 4]] {
+ pass "$testname"
+ } else {
+ fail "$testname"
+ }
+}
+
# Utility for scanning demangled compiler result, invoked via dg-final.
# Call pass if pattern is present, otherwise fail.
#
diff --git a/gcc/testsuite/lib/scantree.exp b/gcc/testsuite/lib/scantree.exp
index 833ac387eb4b..b67713e11cbf 100644
--- a/gcc/testsuite/lib/scantree.exp
+++ b/gcc/testsuite/lib/scantree.exp
@@ -94,6 +94,32 @@ proc scan-tree-dump-not { args } {
}
}
+# Utility for scanning compiler result, invoked via dg-final.
+# Call pass if pattern is present, otherwise fail.
+#
+# Argument 0 is the regexp to match
+# Argument 1 is the name of the dumped tree pass
+# Argument 2 is the variable name to store the matched content
+# Argument 3 handles expected failures and the like
+proc scan-tree-dump-var { args } {
+
+ if { [llength $args] < 3 } {
+ error "scan-tree-dump-var: too few arguments"
+ return
+ }
+ if { [llength $args] > 4 } {
+ error "scan-tree-dump-var: too many arguments"
+ return
+ }
+ if { [llength $args] >= 4 } {
+ scan-dump-var "tree" [lindex $args 0] \
+ "\[0-9\]\[0-9\]\[0-9\]t.[lindex $args 1]" "" [lindex $args 2]
[lindex $args 3]
+ } else {
+ scan-dump-var "tree" [lindex $args 0] \
+ "\[0-9\]\[0-9\]\[0-9\]t.[lindex $args 1]" "" [lindex $args 2]
+ }
+}
+
# Utility for scanning demangled compiler result, invoked via dg-final.
# Call pass if pattern is present, otherwise fail.
#
