Skip to content

Commit 3688619

Browse files
MattPDMattPD
authored
[flang][OpenMP] Do not emit a use-only item for an operator reduction in a module file (#207492)
Stop writing a module file that cannot be re-parsed (reading it crashes) when a module re-exports a USE-associated user-defined operator declare reduction. Such a reduction is represented by an internal symbol whose name is the mangled operator (e.g. "op.remote." or "op.+"), which is not valid Fortran. The module-file writer emitted it as a `use MODULE, only: op.remote.` item, which the reader cannot parse. This affected both a plain re-export facade and an embedded module in a hermetic module file. Skip the use-only item for a reduction whose operator is itself re-exported (a defined operator, or an intrinsic operator with a user interface): the reduction is re-exported implicitly with that operator, which is emitted, and the reduction resolver recovers it from there (FindUserReductionSymbol). This covers a derived-type `operator(+)` reduction as well as a defined operator like `.remote.`. The test checks the re-exporting module file round-trips and that a consumer reading it resolves the reduction through the operator. Assisted-by: Claude Opus 4.8, GPT-5.5.
1 parent 6a91acc commit 3688619

2 files changed

Lines changed: 173 additions & 0 deletions

File tree

‎flang/lib/Semantics/mod-file.cpp‎

Lines changed: 23 additions & 0 deletions
Original file line numberDiff line numberDiff line change
@@ -887,6 +887,29 @@ void ModFileWriter::PutGeneric(const Symbol &symbol) {
887887
}
888888

889889
void ModFileWriter::PutUse(const Symbol &symbol) {
890+
// A declare reduction named by an operator has an internal mangled symbol
891+
// name
892+
// ("op.remote.", "op.+") that is not valid Fortran and cannot be emitted as a
893+
// "use,only:" item (that module file could not be re-parsed, and reading it
894+
// crashed, both for a plain re-export and for an embedded module in a
895+
// hermetic module file). Its operator is itself re-exported as a valid item,
896+
// and the resolver recovers the reduction through it (FindUserReductionSymbol
897+
// / SearchOperatorReduction), keeping one shared reduction symbol, so skip
898+
// the reduction's own use item. This covers a defined operator (which always
899+
// has a mandatory "interface operator(.x.)") and an intrinsic operator with a
900+
// user "interface operator(+)". A reduction named by a plain identifier
901+
// ("myred") has a valid name and is emitted normally below. An operator-less
902+
// reduction (a special function, or an intrinsic operator on an intrinsic
903+
// type) has no operator to recover through and is left to the normal path.
904+
const Symbol &ultimate{symbol.GetUltimate()};
905+
if (ultimate.has<UserReductionDetails>()) {
906+
std::string opId{GetReductionFortranId(ultimate.name())};
907+
const Symbol *opSym{
908+
opId.empty() ? nullptr : ultimate.owner().FindSymbol(opId)};
909+
if (opSym && opSym->GetUltimate().has<GenericDetails>()) {
910+
return;
911+
}
912+
}
890913
auto &details{symbol.get<UseDetails>()};
891914
auto &use{details.symbol()};
892915
const Symbol &module{GetUsedModule(details)};

‎flang/test/Semantics/OpenMP/declare-reduction-operator-modfile-reexport.f90‎

Lines changed: 150 additions & 0 deletions
Original file line numberDiff line numberDiff line change
@@ -0,0 +1,150 @@
1+
! RUN: rm -rf %t && split-file %s %t && cd %t
2+
! A module that uses another module's user-defined declare reduction re-exports
3+
! it. A reduction named by an operator has an internal mangled symbol name
4+
! ("op.remote.", "op.+") that is not valid Fortran, so it must not be written as
5+
! a "use,only:" item (that module file could not be re-parsed and reading it
6+
! crashed); it is recovered through the re-exported operator instead. This holds
7+
! for both a defined operator (".remote.") and an intrinsic operator ("+") with a
8+
! user "interface operator(+)", including when a consumer reaches the reduction
9+
! through both the base and the facade. A reduction named by a plain identifier
10+
! ("myred") has a valid name and is re-exported as a normal "use,only:" item.
11+
12+
! RUN: %flang_fc1 -fsyntax-only -fopenmp rx_base.f90
13+
! RUN: %flang_fc1 -fsyntax-only -fopenmp rx_wrap.f90
14+
! RUN: FileCheck --check-prefix=OPMOD --input-file=rx_wrap.mod %s
15+
! RUN: %flang_fc1 -fsyntax-only -fopenmp rx_use.f90
16+
17+
! RUN: %flang_fc1 -fsyntax-only -fopenmp io_base.f90
18+
! RUN: %flang_fc1 -fsyntax-only -fopenmp io_wrap.f90
19+
! RUN: FileCheck --check-prefix=IOPMOD --input-file=io_wrap.mod %s
20+
! RUN: %flang_fc1 -fsyntax-only -fopenmp io_use.f90
21+
! RUN: %flang_fc1 -fsyntax-only -fopenmp io_dual.f90
22+
23+
! RUN: %flang_fc1 -fsyntax-only -fopenmp nm_base.f90
24+
! RUN: %flang_fc1 -fsyntax-only -fopenmp nm_wrap.f90
25+
! RUN: FileCheck --check-prefix=NMMOD --input-file=nm_wrap.mod %s
26+
! RUN: %flang_fc1 -fsyntax-only -fopenmp nm_use.f90
27+
28+
! The defined operator is re-exported; the mangled reduction symbol is not.
29+
! OPMOD: use rx_base,only:operator(.remote.)
30+
! OPMOD-NOT: only:op.remote.
31+
! The intrinsic operator is re-exported; the mangled reduction symbol is not, and
32+
! the directive is not re-emitted (no facade-owned duplicate reduction).
33+
! IOPMOD: use io_base,only:operator(+)
34+
! IOPMOD-NOT: only:op.+
35+
! IOPMOD-NOT: DECLARE REDUCTION
36+
! The plainly-named reduction is re-exported as a normal use item.
37+
! NMMOD: use nm_base,only:myred
38+
39+
!--- rx_base.f90
40+
module rx_base
41+
type :: t
42+
integer :: val = 0
43+
end type
44+
interface operator(.remote.)
45+
module procedure add_t
46+
end interface
47+
!$omp declare reduction(.remote.:t:omp_out%val=omp_out%val+omp_in%val) &
48+
!$omp initializer(omp_priv=t(0))
49+
contains
50+
type(t) function add_t(a, b)
51+
type(t), intent(in) :: a, b
52+
add_t%val = a%val + b%val
53+
end function
54+
end module
55+
56+
!--- rx_wrap.f90
57+
module rx_wrap
58+
use rx_base
59+
end module
60+
61+
!--- rx_use.f90
62+
program main
63+
use rx_wrap, only: t, operator(.local.) => operator(.remote.)
64+
type(t) :: x
65+
integer :: i
66+
x = t(0)
67+
!$omp parallel do reduction(.local.:x)
68+
do i = 1, 100
69+
x%val = x%val + 1
70+
end do
71+
print *, x%val
72+
end program
73+
74+
!--- nm_base.f90
75+
module nm_base
76+
type :: t
77+
integer :: val = 0
78+
end type
79+
!$omp declare reduction(myred:t:omp_out%val=omp_out%val+omp_in%val) &
80+
!$omp initializer(omp_priv=t(0))
81+
end module
82+
83+
!--- nm_wrap.f90
84+
module nm_wrap
85+
use nm_base
86+
end module
87+
88+
!--- nm_use.f90
89+
program main
90+
use nm_wrap
91+
type(t) :: x
92+
integer :: i
93+
x = t(0)
94+
!$omp parallel do reduction(myred:x)
95+
do i = 1, 100
96+
x%val = x%val + 1
97+
end do
98+
print *, x%val
99+
end program
100+
101+
!--- io_base.f90
102+
module io_base
103+
type :: t
104+
integer :: val = 0
105+
end type
106+
interface operator(+)
107+
module procedure add_t
108+
end interface
109+
!$omp declare reduction(+:t:omp_out=omp_out+omp_in) &
110+
!$omp initializer(omp_priv=t(0))
111+
contains
112+
type(t) function add_t(a, b)
113+
type(t), intent(in) :: a, b
114+
add_t%val = a%val + b%val
115+
end function
116+
end module
117+
118+
!--- io_wrap.f90
119+
module io_wrap
120+
use io_base
121+
end module
122+
123+
!--- io_use.f90
124+
program main
125+
use io_wrap
126+
type(t) :: x
127+
integer :: i
128+
x = t(0)
129+
!$omp parallel do reduction(+:x)
130+
do i = 1, 100
131+
x%val = x%val + 1
132+
end do
133+
print *, x%val
134+
end program
135+
136+
!--- io_dual.f90
137+
! Reaching the reduction through both the base and the facade must bind one
138+
! reduction, not a facade-owned duplicate.
139+
program main
140+
use io_base
141+
use io_wrap
142+
type(t) :: x
143+
integer :: i
144+
x = t(0)
145+
!$omp parallel do reduction(+:x)
146+
do i = 1, 100
147+
x%val = x%val + 1
148+
end do
149+
print *, x%val
150+
end program

0 commit comments

Comments
 (0)