Skip to content

Commit 1ddfa9e

Browse files
gklimowiczgklimowicz
committed
c_associated calls with expression arguments
Compilation of the following call in the bug test case generates an internal compiler error: c_associated(xc_func_info_get_ref(info%ptr, number)) The problem is that the argument to c_associated is a function call rather than a simple identifier (which the compiler handles correctly). Test nag_f08_o op1 contains the call: c_associated(tmp,c_loc(b(1))) Because the second argument is not a simple identifier, the compiler effectively ignores it. In the test, tmp has the same non-null value as c_loc(b(1)), so c_associated(tmp) is TRUE, and the test compiles and executes "correctly". The test fails if the two arguments are swapped. The fix is to temporize expression arguments to c_associated, so that arguments are always simple identifiers.
1 parent 5a5332d commit 1ddfa9e

File tree

6 files changed

+183
-4
lines changed

6 files changed

+183
-4
lines changed

‎test/f90_correct/inc/iso005.mk‎

Lines changed: 23 additions & 0 deletions
Original file line numberDiff line numberDiff line change
@@ -0,0 +1,23 @@
1+
# Copyright (c) 2018, NVIDIA CORPORATION. All rights reserved.
2+
#
3+
# Licensed under the Apache License, Version 2.0 (the "License");
4+
# you may not use this file except in compliance with the License.
5+
# You may obtain a copy of the License at
6+
#
7+
# http://www.apache.org/licenses/LICENSE-2.0
8+
#
9+
# Unless required by applicable law or agreed to in writing, software
10+
# distributed under the License is distributed on an "AS IS" BASIS,
11+
# WITHOUT WARRANTIES OR CONDITIONS OF ANY KIND, either express or implied.
12+
# See the License for the specific language governing permissions and
13+
# limitations under the License.
14+
15+
build:
16+
@echo ------------------------------------- building test $(TEST)
17+
$(FC) $(FFLAGS) $(SRC)/$(TEST).f90 -o $(TEST).$(EXE)
18+
19+
run:
20+
@echo ------------------------------------ executing test $(TEST)
21+
./$(TEST).$(EXE)
22+
23+
verify: ;

‎test/f90_correct/lit/iso005.sh‎

Lines changed: 19 additions & 0 deletions
Original file line numberDiff line numberDiff line change
@@ -0,0 +1,19 @@
1+
#
2+
# Copyright (c) 2017, NVIDIA CORPORATION. All rights reserved.
3+
#
4+
# Licensed under the Apache License, Version 2.0 (the "License");
5+
# you may not use this file except in compliance with the License.
6+
# You may obtain a copy of the License at
7+
#
8+
# http://www.apache.org/licenses/LICENSE-2.0
9+
#
10+
# Unless required by applicable law or agreed to in writing, software
11+
# distributed under the License is distributed on an "AS IS" BASIS,
12+
# WITHOUT WARRANTIES OR CONDITIONS OF ANY KIND, either express or implied.
13+
# See the License for the specific language governing permissions and
14+
# limitations under the License.
15+
16+
# Shared lit script for each tests. Run bash commands that run tests with make.
17+
18+
# RUN: KEEP_FILES=%keep FLAGS=%flags TEST_SRC=%s MAKE_FILE_DIR=%S/.. bash %S/runmake | tee %t
19+
# RUN: cat %t | FileCheck %S/runmake

‎test/f90_correct/src/iso005.f90‎

Lines changed: 136 additions & 0 deletions
Original file line numberDiff line numberDiff line change
@@ -0,0 +1,136 @@
1+
! Copyright (c) 2018, NVIDIA CORPORATION. All rights reserved.
2+
!
3+
! Licensed under the Apache License, Version 2.0 (the "License");
4+
! you may not use this file except in compliance with the License.
5+
! You may obtain a copy of the License at
6+
!
7+
! http://www.apache.org/licenses/LICENSE-2.0
8+
!
9+
! Unless required by applicable law or agreed to in writing, software
10+
! distributed under the License is distributed on an "AS IS" BASIS,
11+
! WITHOUT WARRANTIES OR CONDITIONS OF ANY KIND, either express or implied.
12+
! See the License for the specific language governing permissions and
13+
! limitations under the License.
14+
15+
! c_associated call variants
16+
17+
logical function f1() ! scalars
18+
use, intrinsic :: iso_c_binding, only: c_associated, c_loc, c_null_ptr, c_ptr
19+
implicit none
20+
21+
interface
22+
type(c_ptr) function copy(pp)
23+
import
24+
type(c_ptr) :: pp
25+
end function copy
26+
end interface
27+
28+
integer, target :: a(5), b(5)
29+
type(c_ptr) :: p0, pa, pb, px
30+
logical :: T1, T2, T3, T4, T5, T6, T7, T8
31+
32+
p0 = c_null_ptr
33+
pa = c_loc(a)
34+
pb = c_loc(b)
35+
px = pa
36+
37+
T1 = .not. c_associated(p0)
38+
T2 = c_associated(pa)
39+
T3 = c_associated(pa, px)
40+
T4 = .not. c_associated(pa, pb)
41+
42+
T5 = .not. c_associated(copy(p0))
43+
T6 = c_associated(copy(pa))
44+
T7 = c_associated(copy(pa), copy(px))
45+
T8 = .not. c_associated(copy(pa), copy(pb))
46+
47+
print*, 'f1: ', T1, T2, T3, T4, ' ', T5, T6, T7, T8
48+
f1 = all([T1, T2, T3, T4, T5, T6, T7, T8])
49+
end function f1
50+
51+
logical function f2() ! elements
52+
use, intrinsic :: iso_c_binding, only: c_associated, c_loc, c_ptr
53+
implicit none
54+
55+
interface
56+
type(c_ptr) function copy(pp)
57+
import
58+
type(c_ptr) :: pp
59+
end function copy
60+
end interface
61+
62+
integer, pointer :: a(:), b(:), x(:)
63+
logical :: T1, T2, T3, T4, T5, T6, T7, T8
64+
65+
allocate(x(5))
66+
a => x
67+
b => x(2:5)
68+
69+
T1 = c_associated(c_loc(a(5)))
70+
T2 = .not. c_associated(c_loc(a(1)), c_loc(b(1)))
71+
T3 = c_associated(c_loc(a(2)), c_loc(b))
72+
T4 = c_associated(c_loc(a(2)), c_loc(b(1)))
73+
74+
T5 = c_associated(copy(c_loc(a(5))))
75+
T6 = .not. c_associated(copy(c_loc(a(1))), copy(c_loc(b(1))))
76+
T7 = c_associated(copy(c_loc(a(2))), copy(c_loc(b)))
77+
T8 = c_associated(copy(c_loc(a(2))), copy(c_loc(b(1))))
78+
79+
print*, 'f2: ', T1, T2, T3, T4, ' ', T5, T6, T7, T8
80+
f2 = all([T1, T2, T3, T4, T5, T6, T7, T8])
81+
end function f2
82+
83+
logical function f3() ! components
84+
use, intrinsic :: iso_c_binding, only: c_associated, c_loc, c_null_ptr, c_ptr
85+
implicit none
86+
87+
interface
88+
type(c_ptr) function copy(pp)
89+
import
90+
type(c_ptr) :: pp
91+
end function copy
92+
end interface
93+
94+
type tt
95+
type(c_ptr) :: a, b, z
96+
end type tt
97+
98+
type(tt) :: v
99+
integer, target :: x(5)
100+
logical :: T1, T2, T3, T4, T5, T6, T7, T8
101+
102+
v%a = c_loc(x)
103+
v%b = c_loc(x(2))
104+
v%z = c_null_ptr
105+
106+
T1 = c_associated(v%a)
107+
T2 = .not. c_associated(v%a, v%b)
108+
T3 = c_associated(v%b, c_loc(x(2)))
109+
T4 = .not. c_associated(v%z)
110+
111+
T5 = c_associated(copy(v%a))
112+
T6 = .not. c_associated(copy(v%a), copy(v%b))
113+
T7 = c_associated(copy(v%b), copy(c_loc(x(2))))
114+
T8 = .not. c_associated(copy(v%z))
115+
116+
print*, 'f3: ', T1, T2, T3, T4, ' ', T5, T6, T7, T8
117+
f3 = all([T1, T2, T3, T4, T5, T6, T7, T8])
118+
end function f3
119+
120+
type(c_ptr) function copy(pp)
121+
use, intrinsic :: iso_c_binding, only: c_ptr
122+
implicit none
123+
type(c_ptr) :: pp
124+
copy = pp
125+
end function copy
126+
127+
implicit none
128+
logical :: LL, f1, f2, f3
129+
130+
LL = f1()
131+
LL = LL .and. f2()
132+
LL = LL .and. f3()
133+
134+
if (.not. LL) print*, 'FAIL'
135+
if ( LL) print*, 'PASS'
136+
end

‎tools/flang1/flang1exe/semfunc.c‎

Lines changed: 2 additions & 1 deletion
Original file line numberDiff line numberDiff line change
@@ -5109,7 +5109,8 @@ ref_intrin(SST *stktop, ITEM *list)
51095109
break;
51105110
#ifdef I_C_ASSOCIATED
51115111
case IM_C_ASSOC:
5112-
/*mkexpr(sp);*/
5112+
if (SST_IDG(sp) == S_EXPR)
5113+
(void)tempify(sp);
51135114
mkarg(sp, &dum);
51145115
break;
51155116
#endif

‎tools/flang1/flang1exe/semfunc2.c‎

Lines changed: 1 addition & 2 deletions
Original file line numberDiff line numberDiff line change
@@ -40,7 +40,6 @@
4040
static LOGICAL get_keyword_args(ITEM *, int, char *, int, int);
4141
static int get_fval_array(int);
4242
static LOGICAL cmpat_arr_arg(int, int);
43-
static int tempify(SST *);
4443
static void dump_stfunc(int);
4544

4645
/*---------------------------------------------------------------------*/
@@ -1284,7 +1283,7 @@ chkarg(SST *stkptr, int *dtype)
12841283
/** \brief Allocate a temporary, assign it the value, and return the temp's
12851284
* base.
12861285
*/
1287-
static int
1286+
int
12881287
tempify(SST *stkptr)
12891288
{
12901289
int argtyp;

‎tools/flang1/flang1exe/semstk.h‎

Lines changed: 2 additions & 1 deletion
Original file line numberDiff line numberDiff line change
@@ -1,5 +1,5 @@
11
/*
2-
* Copyright (c) 2017, NVIDIA CORPORATION. All rights reserved.
2+
* Copyright (c) 1994-2018, NVIDIA CORPORATION. All rights reserved.
33
*
44
* Licensed under the Apache License, Version 2.0 (the "License");
55
* you may not use this file except in compliance with the License.
@@ -254,6 +254,7 @@ int define_stfunc(int sptr, ITEM *argl, SST *estk);
254254
int ref_stfunc(SST *stktop, ITEM *args);
255255
int mkarg(SST *stkptr, int *dtype);
256256
int chkarg(SST *stkptr, int *dtype);
257+
int tempify(SST *stkptr);
257258

258259
/* semutil.c */
259260
void constant_lvalue(SST *);

0 commit comments

Comments
 (0)