Skip to content

Commit 5d9aa3d

Browse files
sscalponesscalpone
authored
Merge pull request #634 from ThePortlandGroup/nv_stage
Pull 2018-12-07T10-50 Recent NVIDIA Changes
2 parents 257bdee + 1ddfa9e commit 5d9aa3d

File tree

20 files changed

+270
-27
lines changed

20 files changed

+270
-27
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/accpp.c‎

Lines changed: 1 addition & 1 deletion
Original file line numberDiff line numberDiff line change
@@ -213,7 +213,7 @@ static char ctable[256] = {
213213
#define FORMALMAX 127 /* FS#14308 - set max formals to 127 */
214214
#define ARGMAX 16384
215215
#define TARGMAX 32768
216-
#define MAX_PATHNAME_LEN 350
216+
#define MAX_PATHNAME_LEN 1024
217217
#define MAXINC 20
218218
#define MACSTK_MAX 100
219219

‎tools/flang1/flang1exe/dump.c‎

Lines changed: 2 additions & 0 deletions
Original file line numberDiff line numberDiff line change
@@ -2256,6 +2256,8 @@ dstd(int stdx)
22562256
putint("ast", astx);
22572257
putnzint("lineno", STD_LINENO(stdx));
22582258
putnsym("label", STD_LABEL(stdx));
2259+
if (STD_BLKSYM(stdx) != SPTR_NULL)
2260+
putnsym("blksym", STD_BLKSYM(stdx));
22592261
putint("prev", STD_PREV(stdx));
22602262
putint("next", STD_NEXT(stdx));
22612263
#ifdef STD_TAG

‎tools/flang1/flang1exe/lower.h‎

Lines changed: 9 additions & 5 deletions
Original file line numberDiff line numberDiff line change
@@ -118,14 +118,18 @@
118118
* All of 1.49 +
119119
* Internal procedures passed as arguments and pointer targets
120120
* 18.7 -- 1.51
121-
* All of 1.50 +
122-
* remove parsyms field and add parent for ST_BLOCK,
123-
* pass "has_opts" (no optional arguments) flag for ST_ENTRY and
124-
* ST_PROC symbols to back-end.
121+
* All of 1.50 +
122+
* remove parsyms field and add parent for ST_BLOCK,
123+
* pass "has_opts" (no optional arguments) flag for ST_ENTRY and
124+
* ST_PROC symbols to back-end.
125+
* 18.10 -- 1.52
126+
* All of 1.51 +
127+
* add IS_INTERFACE flag for ST_PROC, and for ST_MODULE when emitting
128+
* as ST_PROC
125129
*
126130
*/
127131
#define VersionMajor 1
128-
#define VersionMinor 51
132+
#define VersionMinor 52
129133

130134
void lower(int);
131135
void lower_end_contains(void);

‎tools/flang1/flang1exe/lowersym.c‎

Lines changed: 8 additions & 0 deletions
Original file line numberDiff line numberDiff line change
@@ -4040,6 +4040,13 @@ lower_symbol(int sptr)
40404040
putbit("vararg", VARARGG(sptr));
40414041
putbit("has_opts", 0);
40424042
putbit("parref", PARREFG(sptr));
4043+
/*
4044+
* emit this bit only if emitting ST_MODULE as ST_PROC
4045+
* this conversion happens in putstype()
4046+
*/
4047+
if (sptr != gbl.currsub)
4048+
putbit("is_interface", IS_INTERFACEG(sptr));
4049+
40434050
strip = 1;
40444051
}
40454052
break;
@@ -4490,6 +4497,7 @@ lower_symbol(int sptr)
44904497
putbit("vararg", 0);
44914498
putbit("has_opts", has_opt_args(sptr) ? 1 : 0);
44924499
putbit("parref", PARREFG(sptr));
4500+
putbit("is_interface", IS_INTERFACEG(sptr));
44934501
if (SCG(sptr) == SC_DUMMY)
44944502
putval("descriptor", IS_PROC_DUMMYG(sptr) ? SDSCG(sptr) : 0);
44954503
if (gbl.stbfil && DTY(DTYPEG(sptr) + 2)) {

‎tools/flang1/flang1exe/rest.c‎

Lines changed: 10 additions & 5 deletions
Original file line numberDiff line numberDiff line change
@@ -1493,12 +1493,17 @@ transform_call(int std, int ast)
14931493
++newi;
14941494
needdescr = needs_descriptor(inface_arg);
14951495
if (needdescr) {
1496-
if (STYPEG(sptr) == ST_PROC && SCG(sptr) != SC_DUMMY) {
1497-
int tmp = get_proc_ptr(sptr);
1498-
if (INTERNALG(sptr)) {
1499-
add_ptr_assign(mk_id(tmp), ele, std);
1496+
if (STYPEG(sptr) == ST_PROC && (SCG(sptr) != SC_DUMMY ||
1497+
SDSCG(sptr))) {
1498+
if (SCG(sptr) != SC_DUMMY) {
1499+
int tmp = get_proc_ptr(sptr);
1500+
if (INTERNALG(sptr)) {
1501+
add_ptr_assign(mk_id(tmp), ele, std);
1502+
}
1503+
ARGT_ARG(newargt, newj) = mk_id(SDSCG(tmp));
1504+
} else {
1505+
ARGT_ARG(newargt, newj) = mk_id(SDSCG(sptr));
15001506
}
1501-
ARGT_ARG(newargt, newj) = mk_id(SDSCG(tmp));
15021507
} else {
15031508
ARGT_ARG(newargt, newj) = get_descr_or_placeholder_arg(inface_arg,
15041509
ele, std);

‎tools/flang1/flang1exe/semant.c‎

Lines changed: 5 additions & 2 deletions
Original file line numberDiff line numberDiff line change
@@ -2315,8 +2315,10 @@ semant1(int rednum, SST *top)
23152315
SCP(sptr, SC_EXTERN);
23162316
else {
23172317
SCP(sptr, SC_NONE);
2318-
if (sem.interf_base[sem.interface - 1].abstract)
2318+
if (sem.interf_base[sem.interface - 1].abstract) {
23192319
ABSTRACTP(sptr, 1);
2320+
INMODULEP(sptr, IN_MODULE);
2321+
}
23202322
}
23212323
}
23222324
PUREP(sptr, subp_prefix.pure);
@@ -13897,7 +13899,8 @@ do_iface_module(void)
1389713899
iface_base[i].iface = 0;
1389813900
}
1389913901
}
13900-
} else if (gbl.currsub && scp && !INMODULEG(iface)) {
13902+
} else if (gbl.currsub && scp &&
13903+
(!INMODULEG(iface) || ABSTRACTG(iface))) {
1390113904
switch (STYPEG(iface)) {
1390213905
case ST_MODPROC:
1390313906
case ST_ALIAS:

‎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

0 commit comments

Comments
 (0)