e3b632337d
Original-commit: flang-compiler/f18@d857c843f5 Reviewed-on: https://github.com/flang-compiler/f18/pull/322 Tree-same-pre-rewrite: false
162 lines
6.1 KiB
Fortran
162 lines
6.1 KiB
Fortran
! 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.
|
|
|
|
! Error tests for structure constructors: C1594 violations
|
|
! from assigning globally-visible data to POINTER components.
|
|
! This test is structconst03.f90 with the type parameters removed.
|
|
|
|
module usefrom
|
|
real :: usedfrom1
|
|
end module usefrom
|
|
|
|
module module1
|
|
use usefrom
|
|
implicit none
|
|
type :: has_pointer1
|
|
real, pointer :: ptop
|
|
type(has_pointer1), allocatable :: link1 ! don't loop during analysis
|
|
end type has_pointer1
|
|
type :: has_pointer2
|
|
type(has_pointer1) :: pnested
|
|
type(has_pointer2), allocatable :: link2
|
|
end type has_pointer2
|
|
type, extends(has_pointer2) :: has_pointer3
|
|
type(has_pointer3), allocatable :: link3
|
|
end type has_pointer3
|
|
type :: t1
|
|
real, pointer :: pt1
|
|
type(t1), allocatable :: link
|
|
end type t1
|
|
type :: t2
|
|
type(has_pointer1) :: hp1
|
|
type(t2), allocatable :: link
|
|
end type t2
|
|
type :: t3
|
|
type(has_pointer2) :: hp2
|
|
type(t3), allocatable :: link
|
|
end type t3
|
|
type :: t4
|
|
type(has_pointer3) :: hp3
|
|
type(t4), allocatable :: link
|
|
end type t4
|
|
real :: modulevar1
|
|
type(has_pointer1) :: modulevar2
|
|
type(has_pointer2) :: modulevar3
|
|
type(has_pointer3) :: modulevar4
|
|
|
|
contains
|
|
|
|
pure real function pf1(dummy1, dummy2, dummy3, dummy4)
|
|
real :: local1
|
|
type(t1) :: x1
|
|
type(t2) :: x2
|
|
type(t3) :: x3
|
|
type(t4) :: x4
|
|
real, intent(in) :: dummy1
|
|
real, intent(inout) :: dummy2
|
|
real, pointer :: dummy3
|
|
real, intent(inout) :: dummy4[*]
|
|
real :: commonvar1
|
|
common /cblock/ commonvar1
|
|
pf1 = 0.
|
|
x1 = t1(local1)
|
|
!ERROR: Externally visible object 'usedfrom1' must not be associated with pointer component 'pt1' in a PURE function
|
|
x1 = t1(usedfrom1)
|
|
!ERROR: Externally visible object 'modulevar1' must not be associated with pointer component 'pt1' in a PURE function
|
|
x1 = t1(modulevar1)
|
|
!ERROR: Externally visible object 'cblock' must not be associated with pointer component 'pt1' in a PURE function
|
|
x1 = t1(commonvar1)
|
|
!ERROR: Externally visible object 'dummy1' must not be associated with pointer component 'pt1' in a PURE function
|
|
x1 = t1(dummy1)
|
|
x1 = t1(dummy2)
|
|
!ERROR: Externally visible object 'dummy3' must not be associated with pointer component 'pt1' in a PURE function
|
|
x1 = t1(dummy3)
|
|
! TODO when semantics handles coindexing:
|
|
! TODO !ERROR: Externally visible object must not be associated with a pointer in a PURE function
|
|
! TODO x1 = t1(dummy4[0])
|
|
x1 = t1(dummy4)
|
|
!ERROR: Externally visible object 'modulevar2' must not be associated with pointer component 'ptop' in a PURE function
|
|
x2 = t2(modulevar2)
|
|
!ERROR: Externally visible object 'modulevar3' must not be associated with pointer component 'ptop' in a PURE function
|
|
x3 = t3(modulevar3)
|
|
!ERROR: Externally visible object 'modulevar4' must not be associated with pointer component 'ptop' in a PURE function
|
|
x4 = t4(modulevar4)
|
|
contains
|
|
subroutine subr(dummy1a, dummy2a, dummy3a, dummy4a)
|
|
real :: local1a
|
|
type(t1) :: x1a
|
|
type(t2) :: x2a
|
|
type(t3) :: x3a
|
|
type(t4) :: x4a
|
|
real, intent(in) :: dummy1a
|
|
real, intent(inout) :: dummy2a
|
|
real, pointer :: dummy3a
|
|
real, intent(inout) :: dummy4a[*]
|
|
x1a = t1(local1a)
|
|
!ERROR: Externally visible object 'usedfrom1' must not be associated with pointer component 'pt1' in a PURE function
|
|
x1a = t1(usedfrom1)
|
|
!ERROR: Externally visible object 'modulevar1' must not be associated with pointer component 'pt1' in a PURE function
|
|
x1a = t1(modulevar1)
|
|
!ERROR: Externally visible object 'cblock' must not be associated with pointer component 'pt1' in a PURE function
|
|
x1a = t1(commonvar1)
|
|
!ERROR: Externally visible object 'dummy1' must not be associated with pointer component 'pt1' in a PURE function
|
|
x1a = t1(dummy1)
|
|
!ERROR: Externally visible object 'dummy1a' must not be associated with pointer component 'pt1' in a PURE function
|
|
x1a = t1(dummy1a)
|
|
x1a = t1(dummy2a)
|
|
!ERROR: Externally visible object 'dummy3' must not be associated with pointer component 'pt1' in a PURE function
|
|
x1a = t1(dummy3)
|
|
!ERROR: Externally visible object 'dummy3a' must not be associated with pointer component 'pt1' in a PURE function
|
|
x1a = t1(dummy3a)
|
|
! TODO when semantics handles coindexing:
|
|
! TODO !ERROR: Externally visible object must not be associated with a pointer in a PURE function
|
|
! TODO x1a = t1(dummy4a[0])
|
|
x1a = t1(dummy4a)
|
|
!ERROR: Externally visible object 'modulevar2' must not be associated with pointer component 'ptop' in a PURE function
|
|
x2a = t2(modulevar2)
|
|
!ERROR: Externally visible object 'modulevar3' must not be associated with pointer component 'ptop' in a PURE function
|
|
x3a = t3(modulevar3)
|
|
!ERROR: Externally visible object 'modulevar4' must not be associated with pointer component 'ptop' in a PURE function
|
|
x4a = t4(modulevar4)
|
|
end subroutine subr
|
|
end function pf1
|
|
|
|
impure real function ipf1(dummy1, dummy2, dummy3, dummy4)
|
|
real :: local1
|
|
type(t1) :: x1
|
|
type(t2) :: x2
|
|
type(t3) :: x3
|
|
type(t4) :: x4
|
|
real, intent(in) :: dummy1
|
|
real, intent(inout) :: dummy2
|
|
real, pointer :: dummy3
|
|
real, intent(inout) :: dummy4[*]
|
|
real :: commonvar1
|
|
common /cblock/ commonvar1
|
|
ipf1 = 0.
|
|
x1 = t1(local1)
|
|
x1 = t1(usedfrom1)
|
|
x1 = t1(modulevar1)
|
|
x1 = t1(commonvar1)
|
|
x1 = t1(dummy1)
|
|
x1 = t1(dummy2)
|
|
x1 = t1(dummy3)
|
|
! TODO when semantics handles coindexing:
|
|
! TODO x1 = t1(dummy4[0])
|
|
x1 = t1(dummy4)
|
|
x2 = t2(modulevar2)
|
|
x3 = t3(modulevar3)
|
|
x4 = t4(modulevar4)
|
|
end function ipf1
|
|
end module module1
|