170 lines · plain
1! RUN: %python %S/test_errors.py %s %flang_fc1 -pedantic2! NULL() intrinsic function error tests3 4subroutine test5 interface6 subroutine s07 end subroutine8 subroutine s1(j)9 integer, intent(in) :: j10 end subroutine11 subroutine canbenull(x, y)12 integer, intent(in), optional :: x13 real, intent(in), pointer :: y14 end15 subroutine optionalAllocatable(x)16 integer, intent(in), allocatable, optional :: x17 end18 function f0()19 real :: f020 end function21 function f1(x)22 real :: f123 real, intent(inout) :: x24 end function25 function f2(p)26 import s027 real :: f128 procedure(s0), pointer, intent(inout) :: p29 end function30 function f3()31 import s132 procedure(s1), pointer :: f333 end function34 end interface35 external implicit36 type :: dt037 integer, pointer :: ip038 integer :: n = 66639 end type dt040 type :: dt141 integer, pointer :: ip1(:)42 end type dt143 type :: dt244 procedure(s0), pointer, nopass :: pps045 end type dt246 type :: dt347 procedure(s1), pointer, nopass :: pps148 end type dt349 type :: dt450 real, allocatable :: ra051 end type dt452 type, extends(dt4) :: dt553 end type dt554 integer :: j55 type(dt0) :: dt0x56 type(dt1) :: dt1x57 type(dt2) :: dt2x58 type(dt3) :: dt3x59 type(dt4) :: dt4x60 integer, pointer :: ip0, ip1(:), ip2(:,:)61 integer, allocatable :: ia0, ia1(:), ia2(:,:)62 real, pointer :: rp0, rp1(:)63 integer, parameter :: ip0r = rank(null(mold=ip0))64 integer, parameter :: ip1r = rank(null(mold=ip1))65 integer, parameter :: ip2r = rank(null(mold=ip2))66 integer, parameter :: eight = ip0r + ip1r + ip2r + 567 real(kind=eight) :: r8check68 logical, pointer :: lp69 type(dt4), pointer :: dt4p70 type(dt5), pointer :: dt5p71 ip0 => null() ! ok72 ip0 => null(null()) ! ok73 ip0 => null(null(null())) ! ok74 ip1 => null() ! ok75 ip1 => null(null()) ! ok76 ip1 => null(null(null())) ! ok77 ip2 => null() ! ok78 ip2 => null(null()) ! ok79 ip2 => null(null(null())) ! ok80 !ERROR: MOLD= argument to NULL() must be a pointer or allocatable81 ip0 => null(mold=1)82 !ERROR: MOLD= argument to NULL() must be a pointer or allocatable83 ip0 => null(null(mold=1))84 !ERROR: MOLD= argument to NULL() must be a pointer or allocatable85 ip0 => null(mold=j)86 !ERROR: MOLD= argument to NULL() must be a pointer or allocatable87 ip0 => null(mold=null(mold=j))88 dt0x = dt0(null())89 dt0x = dt0(ip0=null())90 dt0x = dt0(ip0=null(ip0))91 dt0x = dt0(ip0=null(mold=ip0))92 !ERROR: function result type 'REAL(4)' is not compatible with pointer type 'INTEGER(4)'93 dt0x = dt0(ip0=null(mold=rp0))94 !ERROR: A NULL pointer may not be used as the value for component 'n'95 dt0x = dt0(null(), null())96 !ERROR: function result type 'REAL(4)' is not compatible with pointer type 'INTEGER(4)'97 dt1x = dt1(ip1=null(mold=rp1))98 dt2x = dt2(pps0=null())99 dt2x = dt2(pps0=null(mold=dt2x%pps0))100 !ERROR: Procedure pointer 'pps0' associated with result of reference to function 'null' that is an incompatible procedure pointer: distinct numbers of dummy arguments101 dt2x = dt2(pps0=null(mold=dt3x%pps1))102 !ERROR: Procedure pointer 'pps1' associated with result of reference to function 'null' that is an incompatible procedure pointer: distinct numbers of dummy arguments103 dt3x = dt3(pps1=null(mold=dt2x%pps0))104 dt3x = dt3(pps1=null(mold=dt3x%pps1))105 dt4x = dt4(null()) ! ok106 !PORTABILITY: NULL() with arguments is not standard conforming as the value for allocatable component 'ra0' [-Wnull-mold-allocatable-component-value]107 dt4x = dt4(null(rp0))108 !PORTABILITY: NULL() with arguments is not standard conforming as the value for allocatable component 'ra0' [-Wnull-mold-allocatable-component-value]109 !ERROR: Rank-1 array value is not compatible with scalar component 'ra0'110 dt4x = dt4(null(rp1))111 !ERROR: A NULL procedure pointer may not be used as the value for component 'ra0'112 dt4x = dt4(null(dt2x%pps0))113 call canbenull(null(), null()) ! fine114 call canbenull(null(mold=ip0), null(mold=rp0)) ! fine115 !ERROR: ALLOCATABLE dummy argument 'x=' must be associated with an ALLOCATABLE actual argument116 call optionalAllocatable(null(mold=ip0))117 call optionalAllocatable(null(mold=ia0)) ! fine118 call optionalAllocatable(null()) ! fine119 !ERROR: Null pointer argument 'NULL()' requires an explicit interface120 call implicit(null())121 !ERROR: Null pointer argument 'null(mold=ip0)' requires an explicit interface122 call implicit(null(mold=ip0))123 !ERROR: A NULL() pointer is not allowed for 'x=' intrinsic argument124 print *, sin(null(rp0))125 !ERROR: A NULL() pointer is not allowed for 'x=' intrinsic argument126 print *, kind(null())127 print *, kind(null(rp0)) ! ok128 !ERROR: A NULL() pointer is not allowed for 'a=' intrinsic argument129 print *, extends_type_of(null(), null())130 print *, extends_type_of(null(dt5p), null(dt4p)) ! ok131 !ERROR: A NULL() pointer is not allowed for 'a=' intrinsic argument132 print *, same_type_as(null(), null())133 print *, same_type_as(null(dt5p), null(dt4p)) ! ok134 !ERROR: A NULL() pointer is not allowed for 'source=' intrinsic argument135 print *, transfer(null(rp0),ip0)136 !WARNING: Source of TRANSFER contains allocatable or pointer component %ra0 [-Wpointer-component-transfer-arg]137 print *, transfer(dt4(null()),[0])138 !ERROR: NULL() may not be used as an expression in this context139 select case(null(ip0))140 end select141 !ERROR: NULL() may not be used as an expression in this context142 if (null(lp)) then143 end if144end subroutine test145 146module m147 type :: pdt(n)148 integer, len :: n149 end type150 contains151 subroutine s1(x)152 character(*), pointer, intent(in) :: x153 end154 subroutine s2(x)155 type(pdt(*)), pointer, intent(in) :: x156 end157 subroutine s3(ar)158 real, pointer :: ar(..)159 end160 subroutine test(ar)161 real, pointer :: ar(..)162 !ERROR: Actual argument associated with dummy argument 'x=' is a NULL() pointer without a MOLD= to provide a character length163 call s1(null())164 !ERROR: Actual argument associated with dummy argument 'x=' is a NULL() pointer without a MOLD= to provide a value for the assumed type parameter 'n'165 call s2(null())166 !ERROR: MOLD= argument to NULL() must not be assumed-rank167 call s3(null(ar))168 end169end170