Skip to content
Permalink
Browse files

Fix issue with pointers with strides

In the simply_contiguous() function, for A_SUSCR case check whether
the object is a pointer. If so, we only want to return TRUE if the
subscripted pointer object has the CONTIGUOUS attribute.  Otherwise,
we don't know what the pointer is pointing to at compile-time.

Add pp73 test.
  • Loading branch information
gklimowicz committed Nov 26, 2019
1 parent 0c8e22d commit 265c9c9ac5580f87fd81078e43c265d1854e0912
Showing with 90 additions and 0 deletions.
  1. +35 −0 test/f90_correct/inc/pp73.mk
  2. +19 −0 test/f90_correct/lit/pp73.sh
  3. +32 −0 test/f90_correct/src/pp73.f90
  4. +4 −0 tools/flang1/flang1exe/ast.c
@@ -0,0 +1,35 @@
#
# Copyright (c) 2019, NVIDIA CORPORATION. All rights reserved.
#
# Licensed under the Apache License, Version 2.0 (the "License");
# you may not use this file except in compliance with the License.
# You may obtain a copy of the License at
#
# http://www.apache.org/licenses/LICENSE-2.0
#
# Unless required by applicable law or agreed to in writing, software
# distributed under the License is distributed on an "AS IS" BASIS,
# WITHOUT WARRANTIES OR CONDITIONS OF ANY KIND, either express or implied.
# See the License for the specific language governing permissions and
# limitations under the License.
#
#
########## Make rule for test pp73 ########


pp73: run


build: $(SRC)/pp73.f90
-$(RM) pp73.$(EXESUFFIX) core *.d *.mod FOR*.DAT FTN* ftn* fort.*
@echo ------------------------------------ building test $@
-$(FC) -c $(FFLAGS) $(LDFLAGS) $(SRC)/pp73.f90 -o pp73.$(OBJX)
-$(FC) $(FFLAGS) $(LDFLAGS) pp73.$(OBJX) $(LIBS) -o pp73.$(EXESUFFIX)


run:
@echo ------------------------------------ executing test pp73
pp73.$(EXESUFFIX)

verify: ;

@@ -0,0 +1,19 @@
#
# Copyright (c) 2017, NVIDIA CORPORATION. All rights reserved.
#
# Licensed under the Apache License, Version 2.0 (the "License");
# you may not use this file except in compliance with the License.
# You may obtain a copy of the License at
#
# http://www.apache.org/licenses/LICENSE-2.0
#
# Unless required by applicable law or agreed to in writing, software
# distributed under the License is distributed on an "AS IS" BASIS,
# WITHOUT WARRANTIES OR CONDITIONS OF ANY KIND, either express or implied.
# See the License for the specific language governing permissions and
# limitations under the License.

# Shared lit script for each tests. Run bash commands that run tests with make.

# RUN: KEEP_FILES=%keep FLAGS=%flags TEST_SRC=%s MAKE_FILE_DIR=%S/.. bash %S/runmake | tee %t
# RUN: cat %t | FileCheck %S/runmake
@@ -0,0 +1,32 @@
! Copyright (c) 2019, NVIDIA CORPORATION. All rights reserved.
!
! Licensed under the Apache License, Version 2.0 (the "License");
! you may not use this file except in compliance with the License.
! You may obtain a copy of the License at
!
! http://www.apache.org/licenses/LICENSE-2.0
!
! Unless required by applicable law or agreed to in writing, software
! distributed under the License is distributed on an "AS IS" BASIS,
! WITHOUT WARRANTIES OR CONDITIONS OF ANY KIND, either express or implied.
! See the License for the specific language governing permissions and
! limitations under the License.
!
!
! Tests subscripted pointer expressions that point to non-contiguous array
! sections.

program main
integer, pointer :: p1(:), p2(:)
integer, target :: a(20)
integer :: expect(8) = [3, 5, 7, 9, 11, 13, 15, 17]
integer :: j
a = [(j,j=1,20)]
p1 => a(::2)
p2(1:8) => p1(2:9)
if (all(p2 .eq. expect)) then
print *, 'PASS'
else
print *, 'FAIL'
endif
end program main
@@ -3429,6 +3429,10 @@ simply_contiguous(int arr_ast)
}
break;
case A_SUBSCR:
sptr = memsym_of_ast(arr_ast);
if (POINTERG(sptr)) {
return CONTIGATTRG(sptr);
}
return contiguous_array_section(arr_ast);
}

0 comments on commit 265c9c9

Please sign in to comment.
You can’t perform that action at this time.