Skip to content

Commit 51688a5

Browse files
yaoliu-hncbryanpkc
yaoliu-hnc
authored and
bryanpkc
committed
Revert "Revert "Fix 2 errors of entry statement processing (#1036)""
This reverts commit 4233eb3.
1 parent cbb6627 commit 51688a5

File tree

10 files changed

+351
-9
lines changed

10 files changed

+351
-9
lines changed

‎test/f90_correct/inc/en03.mk‎

Lines changed: 28 additions & 0 deletions
Original file line numberDiff line numberDiff line change
@@ -0,0 +1,28 @@
1+
#
2+
# Part of the LLVM Project, under the Apache License v2.0 with LLVM Exceptions.
3+
# See https://llvm.org/LICENSE.txt for license information.
4+
# SPDX-License-Identifier: Apache-2.0 WITH LLVM-exception
5+
#
6+
7+
########## Make rule for test en03 ########
8+
9+
10+
en03: run
11+
12+
13+
build: $(SRC)/en03.f90
14+
-$(RM) en03.$(EXESUFFIX) core *.d *.mod FOR*.DAT FTN* ftn* fort.*
15+
@echo ------------------------------------ building test $@
16+
-$(CC) -c $(CFLAGS) $(SRC)/check.c -o check.$(OBJX)
17+
-$(FC) -c $(FFLAGS) $(LDFLAGS) $(SRC)/en03.f90 -o en03.$(OBJX)
18+
-$(FC) $(FFLAGS) $(LDFLAGS) en03.$(OBJX) check.$(OBJX) $(LIBS) -o en03.$(EXESUFFIX)
19+
20+
21+
run:
22+
@echo ------------------------------------ executing test en03
23+
en03.$(EXESUFFIX)
24+
25+
verify: ;
26+
27+
en03.run: run
28+

‎test/f90_correct/inc/en04.mk‎

Lines changed: 23 additions & 0 deletions
Original file line numberDiff line numberDiff line change
@@ -0,0 +1,23 @@
1+
#
2+
# Part of the LLVM Project, under the Apache License v2.0 with LLVM Exceptions.
3+
# See https://llvm.org/LICENSE.txt for license information.
4+
# SPDX-License-Identifier: Apache-2.0 WITH LLVM-exception
5+
#
6+
7+
$(TEST): run
8+
9+
10+
build: $(SRC)/$(TEST).f90
11+
-$(RM) $(TEST).$(EXESUFFIX) core *.d *.mod FOR*.DAT FTN* ftn* fort.*
12+
@echo ------------------------------------ building test $@
13+
-$(CC) -c $(CFLAGS) $(SRC)/check.c -o check.$(OBJX)
14+
-$(FC) -c $(FFLAGS) $(LDFLAGS) $(SRC)/$(TEST).f90 -o $(TEST).$(OBJX)
15+
-$(FC) $(FFLAGS) $(LDFLAGS) $(TEST).$(OBJX) check.$(OBJX) $(LIBS) -o $(TEST).$(EXESUFFIX)
16+
17+
18+
run:
19+
@echo ------------------------------------ executing test $(TEST)
20+
$(TEST).$(EXESUFFIX)
21+
22+
verify: ;
23+

‎test/f90_correct/lit/en03.sh‎

Lines changed: 9 additions & 0 deletions
Original file line numberDiff line numberDiff line change
@@ -0,0 +1,9 @@
1+
#
2+
# Part of the LLVM Project, under the Apache License v2.0 with LLVM Exceptions.
3+
# See https://llvm.org/LICENSE.txt for license information.
4+
# SPDX-License-Identifier: Apache-2.0 WITH LLVM-exception
5+
6+
# Shared lit script for each tests. Run bash commands that run tests with make.
7+
8+
# RUN: KEEP_FILES=%keep FLAGS=%flags TEST_SRC=%s MAKE_FILE_DIR=%S/.. bash %S/runmake | tee %t
9+
# RUN: cat %t | FileCheck %S/runmake

‎test/f90_correct/lit/en04.sh‎

Lines changed: 9 additions & 0 deletions
Original file line numberDiff line numberDiff line change
@@ -0,0 +1,9 @@
1+
#
2+
# Part of the LLVM Project, under the Apache License v2.0 with LLVM Exceptions.
3+
# See https://llvm.org/LICENSE.txt for license information.
4+
# SPDX-License-Identifier: Apache-2.0 WITH LLVM-exception
5+
6+
# Shared lit script for each tests. Run bash commands that run tests with make.
7+
8+
# RUN: KEEP_FILES=%keep FLAGS=%flags TEST_SRC=%s MAKE_FILE_DIR=%S/.. bash %S/runmake | tee %t
9+
# RUN: cat %t | FileCheck %S/runmake

‎test/f90_correct/src/en03.f90‎

Lines changed: 59 additions & 0 deletions
Original file line numberDiff line numberDiff line change
@@ -0,0 +1,59 @@
1+
!
2+
! Part of the LLVM Project, under the Apache License v2.0 with LLVM Exceptions.
3+
! See https://llvm.org/LICENSE.txt for license information.
4+
! SPDX-License-Identifier: Apache-2.0 WITH LLVM-exception
5+
!
6+
! Test entry for cases:
7+
! 1) Function return complex, entry return integer
8+
! 2) All entries return pointer
9+
10+
function f1()
11+
complex :: f1
12+
integer :: e1
13+
f1 = (1, 1)
14+
return
15+
entry e1()
16+
e1 = 2
17+
return
18+
end function
19+
20+
function f2()
21+
integer, pointer :: f2, e2
22+
allocate(f2)
23+
f2 = 3
24+
return
25+
entry e2()
26+
allocate(e2)
27+
e2 = 4
28+
return
29+
end function
30+
31+
program test
32+
interface
33+
function f1()
34+
complex :: f1
35+
end function
36+
function e1()
37+
integer :: e1
38+
end function
39+
function f2()
40+
integer, pointer :: f2
41+
end function
42+
function e2()
43+
integer, pointer :: e2
44+
end function
45+
end interface
46+
47+
integer, parameter :: n = 4
48+
integer :: rslts(n), expect(n)
49+
50+
rslts = 0
51+
expect = 1
52+
53+
if(f1() .eq. (1, 1)) rslts(1) = 1
54+
if(e1() .eq. 2) rslts(2) = 1
55+
if(f2() .eq. 3) rslts(3) = 1
56+
if(e2() .eq. 4) rslts(4) = 1
57+
58+
call check(rslts, expect, n)
59+
end program

‎test/f90_correct/src/en04.f90‎

Lines changed: 91 additions & 0 deletions
Original file line numberDiff line numberDiff line change
@@ -0,0 +1,91 @@
1+
!
2+
! Part of the LLVM Project, under the Apache License v2.0 with LLVM Exceptions.
3+
! See https://llvm.org/LICENSE.txt for license information.
4+
! SPDX-License-Identifier: Apache-2.0 WITH LLVM-exception
5+
!
6+
! Test for all ENTRY points with the same return type identify the same variable
7+
8+
function f1 ()
9+
integer :: f1, e1
10+
entry e1 ()
11+
e1 = 1
12+
end function
13+
14+
function f2 ()
15+
complex :: f2, e2
16+
entry e2 ()
17+
e2 = (2, 2)
18+
end function
19+
20+
function f3 ()
21+
integer, pointer :: f3, e3
22+
entry e3 ()
23+
allocate(e3)
24+
e3 = 3
25+
end function
26+
27+
function f4 ()
28+
integer, dimension(4) :: f4, e4
29+
entry e4 ()
30+
e4 = (/1,2,3,4/)
31+
end function
32+
33+
function f5 ()
34+
integer, dimension(:), pointer :: f5, e5
35+
entry e5 ()
36+
allocate(e5(5))
37+
e5 = (/1,2,3,4,5/)
38+
end function
39+
40+
program test
41+
interface
42+
function f1 ()
43+
integer :: f1
44+
end function
45+
function e1 ()
46+
integer :: e1
47+
end function
48+
function f2 ()
49+
complex :: f2
50+
end function
51+
function e2 ()
52+
complex :: e2
53+
end function
54+
function f3 ()
55+
integer, pointer :: f3
56+
end function
57+
function e3 ()
58+
integer, pointer :: e3
59+
end function
60+
function f4 ()
61+
integer, dimension(4) :: f4
62+
end function
63+
function e4 ()
64+
integer, dimension(4) :: e4
65+
end function
66+
function f5 ()
67+
integer, dimension(:), pointer :: f5
68+
end function
69+
function e5 ()
70+
integer, dimension(:), pointer :: e5
71+
end function
72+
end interface
73+
74+
integer, parameter :: n = 10
75+
integer :: rslts(n), expect(n)
76+
77+
rslts = 0
78+
expect = 1
79+
if (f1() == 1) rslts(1) = 1
80+
if (e1() == 1) rslts(2) = 1
81+
if (f2() == (2, 2)) rslts(3) = 1
82+
if (e2() == (2, 2)) rslts(4) = 1
83+
if (f3() == 3) rslts(5) = 1
84+
if (e3() == 3) rslts(6) = 1
85+
if (all(f4() == (/1,2,3,4/))) rslts(7) = 1
86+
if (all(e4() == (/1,2,3,4/))) rslts(8) = 1
87+
if (all(f5() == (/1,2,3,4,5/))) rslts(9) = 1
88+
if (all(e5() == (/1,2,3,4,5/))) rslts(10) = 1
89+
90+
call check(rslts, expect, n)
91+
end program

‎tools/flang1/flang1exe/lowersym.c‎

Lines changed: 102 additions & 2 deletions
Original file line numberDiff line numberDiff line change
@@ -1225,13 +1225,110 @@ lower_pointer_init(void)
12251225
}
12261226
} /* lower_pointer_init */
12271227

1228+
/* When prepend_func_result_as_first_arg(semfin.c) has been called for an
1229+
* entry, the FVAL symbol and its descriptor symbol if exist are referred in
1230+
* the entry's dummy arguments.
1231+
* When we are going to identify all result variables of same dtype from
1232+
* different entry points with a single symbol, here we traverse all the dummy
1233+
* arguments, and replace the FVAL symbol and its descriptor symbol with this
1234+
* single symbol and corresponding descriptor symbol.
1235+
*/
1236+
static void
1237+
replace_fval_in_params(SPTR entry, SPTR entrysame)
1238+
{
1239+
SPTR fval, fvalsame, newdsc, newdscsame, newarg, newargsame;
1240+
int params, narg, i;
1241+
1242+
fval = FVALG(entry);
1243+
fvalsame = FVALG(entrysame);
1244+
newdsc = NEWDSCG(fval);
1245+
newarg = NEWARGG(fval);
1246+
newdscsame = NEWDSCG(fvalsame);
1247+
newargsame = NEWARGG(fvalsame);
1248+
params = DPDSCG(entry);
1249+
narg = PARAMCTG(entry);
1250+
for (i = 0; i < narg; i++) {
1251+
int arg = aux.dpdsc_base[params + i];
1252+
if (arg != 0 && arg == newarg) {
1253+
aux.dpdsc_base[params + i] = newargsame;
1254+
continue;
1255+
}
1256+
if (arg != 0 && arg == newdsc) {
1257+
aux.dpdsc_base[params + i] = newdscsame;
1258+
continue;
1259+
}
1260+
}
1261+
}
1262+
1263+
/* replace the symbol used in the ast of type A_ID taking advantage of the hash
1264+
* in the AST table
1265+
*/
1266+
static void
1267+
replace_sptr_in_ast(SPTR sptr)
1268+
{
1269+
SPTR newsptr;
1270+
int ast;
1271+
1272+
if (sptr <= NOSYM) {
1273+
return;
1274+
}
1275+
newsptr = LOWER_SYMBOL_REPLACE(sptr);
1276+
if (newsptr <= NOSYM) {
1277+
return;
1278+
}
1279+
ast = mk_id(sptr);
1280+
A_SPTRP(ast, newsptr);
1281+
}
1282+
1283+
static inline void
1284+
add_replace_map(SPTR sptr, SPTR newsptr)
1285+
{
1286+
if (sptr <= NOSYM || newsptr <= NOSYM) {
1287+
return;
1288+
}
1289+
LOWER_SYMBOL_REPLACE(sptr) = newsptr;
1290+
}
1291+
1292+
/* replace the fval symbol and associated symbols when the fval symbol is
1293+
* pointer or array
1294+
*/
1295+
static void
1296+
replace_fval_in_ast(SPTR fval, SPTR fvalsame)
1297+
{
1298+
SPTR var, var_same;
1299+
1300+
replace_sptr_in_ast(fval);
1301+
1302+
var = MIDNUMG(fval);
1303+
var_same = MIDNUMG(fvalsame);
1304+
add_replace_map(var, var_same);
1305+
replace_sptr_in_ast(var);
1306+
1307+
var = PTROFFG(fval);
1308+
var_same = PTROFFG(fvalsame);
1309+
add_replace_map(var, var_same);
1310+
replace_sptr_in_ast(var);
1311+
1312+
var = DESCRG(fval);
1313+
var_same = DESCRG(fvalsame);
1314+
add_replace_map(var, var_same);
1315+
replace_sptr_in_ast(var);
1316+
1317+
var = SDSCG(fval);
1318+
var_same = SDSCG(fvalsame);
1319+
add_replace_map(var, var_same);
1320+
replace_sptr_in_ast(var);
1321+
}
1322+
12281323
extern int pghpf_type_sptr;
12291324
extern int pghpf_local_mode_sptr;
12301325

12311326
void
12321327
lower_init_sym(void)
12331328
{
12341329
int sym, dtype;
1330+
LOGICAL from_func;
1331+
12351332
lowersym.sc = SC_LOCAL;
12361333
lowersym.parallel_depth = 0;
12371334
lowersym.task_depth = 0;
@@ -1357,21 +1454,24 @@ lower_init_sym(void)
13571454
stack_size = 100;
13581455
NEW(stack, int, stack_size);
13591456

1457+
from_func = gbl.rutype == RU_SUBR && gbl.entries > NOSYM && FVALG(gbl.entries);
13601458
/* look for ENTRY points; make all ENTRY points with the same
13611459
* return type use the same FVAL symbol */
1362-
if (gbl.rutype == RU_FUNC) {
1460+
if (from_func || gbl.rutype == RU_FUNC) {
13631461
int ent, esame;
13641462
for (ent = gbl.entries; ent > NOSYM; ent = SYMLKG(ent)) {
13651463
for (esame = gbl.entries; esame != ent; esame = SYMLKG(esame)) {
13661464
int fval, fvalsame;
13671465
fval = FVALG(ent);
13681466
fvalsame = FVALG(esame);
13691467
if (fval && fvalsame && fval != fvalsame &&
1370-
DTYPEG(fval) == DTYPEG(fvalsame)) {
1468+
same_dtype(DTYPEG(fval), DTYPEG(fvalsame))) {
13711469
/* esame is the earlier entry point, make ent use the
13721470
* FVAL of esame */
13731471
LOWER_SYMBOL_REPLACE(fval) = fvalsame;
1472+
replace_fval_in_params(ent, esame);
13741473
FVALP(ent, fvalsame);
1474+
replace_fval_in_ast(fval, fvalsame);
13751475
break; /* leave inner loop */
13761476
}
13771477
}

‎tools/flang1/flang1exe/semfin.c‎

Lines changed: 4 additions & 1 deletion
Original file line numberDiff line numberDiff line change
@@ -467,10 +467,13 @@ semfin(void)
467467
error(45, 3, gbl.lineno, SYMNAME(sptr), SYMNAME(gbl.entries));
468468
pointer_check:
469469
STYPEP(FVALG(sptr), ST_VAR);
470-
if (POINTERG(sptr) || ALLOCATTRG(FVALG(sptr))) {
470+
if (POINTERG(FVALG(sptr)) || ALLOCATTRG(FVALG(sptr))) {
471471
/* We convert a pointer-valued function into a subroutine whose
472472
* first dummy argument is the result now, really late in
473473
* semantic analysis.
474+
* Check the attributes of fval instead of the attributes of entry,
475+
* because only the first entry can get all attributes defined by
476+
* fval through copy_type_to_entry(semant.c).
474477
*/
475478
prepend_func_result_as_first_arg(sptr);
476479
gbl.rutype = RU_SUBR;

0 commit comments

Comments
 (0)