diff --git a/Fortran/UnitTests/CMakeLists.txt b/Fortran/UnitTests/CMakeLists.txt index 84979dd70f..a8e17338a1 100644 --- a/Fortran/UnitTests/CMakeLists.txt +++ b/Fortran/UnitTests/CMakeLists.txt @@ -2,3 +2,4 @@ add_subdirectory(hello) add_subdirectory(fcvs21_f95) # NIST Fortran Compiler Validation Suite add_subdirectory(finalization) +add_subdirectory(assumed-rank) diff --git a/Fortran/UnitTests/assumed-rank/CMakeLists.txt b/Fortran/UnitTests/assumed-rank/CMakeLists.txt new file mode 100644 index 0000000000..8b9f2da57c --- /dev/null +++ b/Fortran/UnitTests/assumed-rank/CMakeLists.txt @@ -0,0 +1,3 @@ +llvm_singlesource() + +file(COPY lit.local.cfg DESTINATION "${CMAKE_CURRENT_BINARY_DIR}") diff --git a/Fortran/UnitTests/assumed-rank/dummy-select-intrinsic.f90 b/Fortran/UnitTests/assumed-rank/dummy-select-intrinsic.f90 new file mode 100644 index 0000000000..a1e699232f --- /dev/null +++ b/Fortran/UnitTests/assumed-rank/dummy-select-intrinsic.f90 @@ -0,0 +1,261 @@ +module check_rank_utilities + + private + public :: print_rank, check_contiguous_assumed_rank_arg + + type, public :: derived_type + integer :: x,y + end type + +contains + + subroutine check_contiguous_assumed_rank_arg(arg) + type(*), intent(in), contiguous, target :: arg(..) + + if (is_contiguous(arg)) then + print '(a)', "Assumed rank arg with contiguous and target attribute is contiguous" + else + print '(a)', "Assumed rank arg with contiguous and target attribute is NOT contiguous" + end if + end subroutine + + subroutine print_rank(a) + class(*) a(..) + + select rank(a) + rank(0) + call check_rank(0,rank(a)) + rank(1) + call check_rank(1,rank(a)) + rank(2) + call check_rank(2,rank(a)) + rank(3) + call check_rank(3,rank(a)) + rank(4) + call check_rank(4,rank(a)) + rank(5) + call check_rank(5,rank(a)) + rank(6) + call check_rank(6,rank(a)) + rank(7) + call check_rank(7,rank(a)) + rank(8) + call check_rank(8,rank(a)) + rank(9) + call check_rank(9,rank(a)) + rank(10) + call check_rank(10,rank(a)) + rank(11) + call check_rank(11,rank(a)) + rank(12) + call check_rank(12,rank(a)) + rank(13) + call check_rank(13,rank(a)) + rank(14) + call check_rank(14,rank(a)) + rank(15) + call check_rank(15,rank(a)) + rank default + error stop "unrecognized rank" + end select + end subroutine + + subroutine check_rank(select_val, intrinsic_val) + integer, intent(in) :: select_val, intrinsic_val + + if (select_val.eq.intrinsic_val) then + print '(a,i2)', "rank(a) = ", intrinsic_val + else + print '(a)', "select rank value ", select_val, "doesn't match rank reported from `rank` intrinsic ", intrinsic_val + end if + end subroutine + +end module + +program rank_dummy_select_intrinsic + use check_rank_utilities, only: print_rank, derived_type, check_contiguous_assumed_rank_arg + implicit none + integer :: scalar = 1, rank1_arr(10) = 1, rank2_arr(6,6) = 1 + + call check_integer + call check_real + call check_double_precision + call check_complex + call check_character + call check_logical + call check_derived_type + call check_contiguous_assumed_rank_arg(scalar); + call check_contiguous_assumed_rank_arg(rank1_arr(1:6:2)); + call check_contiguous_assumed_rank_arg(rank2_arr); + +contains + + subroutine check_integer + integer a, a1(1), a2(1,1), a3(1,1,1), a4(1,1,1, 1), a5(1,1,1, 1,1), a6(1,1,1, 1,1,1), a7(1,1,1, 1,1,1, 1) + integer a8(1,1,1, 1,1,1, 1,1), a9(1,1,1, 1,1,1, 1,1,1), a10(1,1,1, 1,1,1, 1,1,1, 1), a11(1,1,1, 1,1,1, 1,1,1, 1,1) + integer a12(1,1,1, 1,1,1, 1,1,1, 1,1,1), a13(1,1,1, 1,1,1, 1,1,1, 1,1,1, 1), a14(1,1,1, 1,1,1, 1,1,1, 1,1,1, 1,1) + integer a15(1,1,1, 1,1,1, 1,1,1, 1,1,1, 1,1,1) + + call print_rank(a) + call print_rank(a1) + call print_rank(a2) + call print_rank(a3) + call print_rank(a4) + call print_rank(a5) + call print_rank(a6) + call print_rank(a7) + call print_rank(a8) + call print_rank(a9) + call print_rank(a10) + call print_rank(a11) + call print_rank(a12) + call print_rank(a13) + call print_rank(a14) + call print_rank(a15) + end subroutine check_integer + + subroutine check_real + real a, a1(1), a2(1,1), a3(1,1,1), a4(1,1,1, 1), a5(1,1,1, 1,1), a6(1,1,1, 1,1,1), a7(1,1,1, 1,1,1, 1) + real a8(1,1,1, 1,1,1, 1,1), a9(1,1,1, 1,1,1, 1,1,1), a10(1,1,1, 1,1,1, 1,1,1, 1), a11(1,1,1, 1,1,1, 1,1,1, 1,1) + real a12(1,1,1, 1,1,1, 1,1,1, 1,1,1), a13(1,1,1, 1,1,1, 1,1,1, 1,1,1, 1), a14(1,1,1, 1,1,1, 1,1,1, 1,1,1, 1,1) + real a15(1,1,1, 1,1,1, 1,1,1, 1,1,1, 1,1,1) + + call print_rank(a) + call print_rank(a1) + call print_rank(a2) + call print_rank(a3) + call print_rank(a4) + call print_rank(a5) + call print_rank(a6) + call print_rank(a7) + call print_rank(a8) + call print_rank(a9) + call print_rank(a10) + call print_rank(a11) + call print_rank(a12) + call print_rank(a13) + call print_rank(a14) + call print_rank(a15) + end subroutine check_real + + subroutine check_double_precision + double precision a, a1(1), a2(1,1), a3(1,1,1), a4(1,1,1, 1), a5(1,1,1, 1,1), a6(1,1,1, 1,1,1), a7(1,1,1, 1,1,1, 1) + double precision a8(1,1,1, 1,1,1, 1,1), a9(1,1,1, 1,1,1, 1,1,1), a10(1,1,1, 1,1,1, 1,1,1, 1), a11(1,1,1, 1,1,1, 1,1,1, 1,1) + double precision a12(1,1,1, 1,1,1, 1,1,1, 1,1,1), a13(1,1,1, 1,1,1, 1,1,1, 1,1,1, 1), a14(1,1,1, 1,1,1, 1,1,1, 1,1,1, 1,1) + double precision a15(1,1,1, 1,1,1, 1,1,1, 1,1,1, 1,1,1) + + call print_rank(a) + call print_rank(a1) + call print_rank(a2) + call print_rank(a3) + call print_rank(a4) + call print_rank(a5) + call print_rank(a6) + call print_rank(a7) + call print_rank(a8) + call print_rank(a9) + call print_rank(a10) + call print_rank(a11) + call print_rank(a12) + call print_rank(a13) + call print_rank(a14) + call print_rank(a15) + end subroutine check_double_precision + + subroutine check_complex + complex a, a1(1), a2(1,1), a3(1,1,1), a4(1,1,1, 1), a5(1,1,1, 1,1), a6(1,1,1, 1,1,1), a7(1,1,1, 1,1,1, 1) + complex a8(1,1,1, 1,1,1, 1,1), a9(1,1,1, 1,1,1, 1,1,1), a10(1,1,1, 1,1,1, 1,1,1, 1), a11(1,1,1, 1,1,1, 1,1,1, 1,1) + complex a12(1,1,1, 1,1,1, 1,1,1, 1,1,1), a13(1,1,1, 1,1,1, 1,1,1, 1,1,1, 1), a14(1,1,1, 1,1,1, 1,1,1, 1,1,1, 1,1) + complex a15(1,1,1, 1,1,1, 1,1,1, 1,1,1, 1,1,1) + + call print_rank(a) + call print_rank(a1) + call print_rank(a2) + call print_rank(a3) + call print_rank(a4) + call print_rank(a5) + call print_rank(a6) + call print_rank(a7) + call print_rank(a8) + call print_rank(a9) + call print_rank(a10) + call print_rank(a11) + call print_rank(a12) + call print_rank(a13) + call print_rank(a14) + call print_rank(a15) + end subroutine check_complex + + subroutine check_character + character(len=1) a, a1(1), a2(1,1), a3(1,1,1), a4(1,1,1, 1), a5(1,1,1, 1,1), a6(1,1,1, 1,1,1), a7(1,1,1, 1,1,1, 1) + character(len=1) a8(1,1,1, 1,1,1, 1,1), a9(1,1,1, 1,1,1, 1,1,1), a10(1,1,1, 1,1,1, 1,1,1, 1), a11(1,1,1, 1,1,1, 1,1,1, 1,1) + character(len=1) a12(1,1,1, 1,1,1, 1,1,1, 1,1,1), a13(1,1,1, 1,1,1, 1,1,1, 1,1,1, 1), a14(1,1,1, 1,1,1, 1,1,1, 1,1,1, 1,1) + character(len=1) a15(1,1,1, 1,1,1, 1,1,1, 1,1,1, 1,1,1) + + call print_rank(a) + call print_rank(a1) + call print_rank(a2) + call print_rank(a3) + call print_rank(a4) + call print_rank(a5) + call print_rank(a6) + call print_rank(a7) + call print_rank(a8) + call print_rank(a9) + call print_rank(a10) + call print_rank(a11) + call print_rank(a12) + call print_rank(a13) + call print_rank(a14) + call print_rank(a15) + end subroutine check_character + + subroutine check_logical + logical a, a1(1), a2(1,1), a3(1,1,1), a4(1,1,1, 1), a5(1,1,1, 1,1), a6(1,1,1, 1,1,1), a7(1,1,1, 1,1,1, 1) + logical a8(1,1,1, 1,1,1, 1,1), a9(1,1,1, 1,1,1, 1,1,1), a10(1,1,1, 1,1,1, 1,1,1, 1), a11(1,1,1, 1,1,1, 1,1,1, 1,1) + logical a12(1,1,1, 1,1,1, 1,1,1, 1,1,1), a13(1,1,1, 1,1,1, 1,1,1, 1,1,1, 1), a14(1,1,1, 1,1,1, 1,1,1, 1,1,1, 1,1) + logical a15(1,1,1, 1,1,1, 1,1,1, 1,1,1, 1,1,1) + + call print_rank(a) + call print_rank(a1) + call print_rank(a2) + call print_rank(a3) + call print_rank(a4) + call print_rank(a5) + call print_rank(a6) + call print_rank(a7) + call print_rank(a8) + call print_rank(a9) + call print_rank(a10) + call print_rank(a11) + call print_rank(a12) + call print_rank(a13) + call print_rank(a14) + call print_rank(a15) + end subroutine check_logical + + subroutine check_derived_type + type(derived_type) a, a1(1), a2(1,1), a3(1,1,1), a4(1,1,1, 1), a5(1,1,1, 1,1), a6(1,1,1, 1,1,1), a7(1,1,1, 1,1,1, 1) + type(derived_type) a8(1,1,1, 1,1,1, 1,1), a9(1,1,1, 1,1,1, 1,1,1), a10(1,1,1, 1,1,1, 1,1,1, 1), a11(1,1,1, 1,1,1, 1,1,1, 1,1) + type(derived_type) a12(1,1,1, 1,1,1, 1,1,1, 1,1,1), a13(1,1,1, 1,1,1, 1,1,1, 1,1,1, 1), a14(1,1,1, 1,1,1, 1,1,1, 1,1,1, 1,1) + type(derived_type) a15(1,1,1, 1,1,1, 1,1,1, 1,1,1, 1,1,1) + + call print_rank(a) + call print_rank(a1) + call print_rank(a2) + call print_rank(a3) + call print_rank(a4) + call print_rank(a5) + call print_rank(a6) + call print_rank(a7) + call print_rank(a8) + call print_rank(a9) + call print_rank(a10) + call print_rank(a11) + call print_rank(a12) + call print_rank(a13) + call print_rank(a14) + call print_rank(a15) + end subroutine check_derived_type + +end program rank_dummy_select_intrinsic diff --git a/Fortran/UnitTests/assumed-rank/dummy-select-intrinsic.reference_output b/Fortran/UnitTests/assumed-rank/dummy-select-intrinsic.reference_output new file mode 100644 index 0000000000..690d713d92 --- /dev/null +++ b/Fortran/UnitTests/assumed-rank/dummy-select-intrinsic.reference_output @@ -0,0 +1,116 @@ +rank(a) = 0 +rank(a) = 1 +rank(a) = 2 +rank(a) = 3 +rank(a) = 4 +rank(a) = 5 +rank(a) = 6 +rank(a) = 7 +rank(a) = 8 +rank(a) = 9 +rank(a) = 10 +rank(a) = 11 +rank(a) = 12 +rank(a) = 13 +rank(a) = 14 +rank(a) = 15 +rank(a) = 0 +rank(a) = 1 +rank(a) = 2 +rank(a) = 3 +rank(a) = 4 +rank(a) = 5 +rank(a) = 6 +rank(a) = 7 +rank(a) = 8 +rank(a) = 9 +rank(a) = 10 +rank(a) = 11 +rank(a) = 12 +rank(a) = 13 +rank(a) = 14 +rank(a) = 15 +rank(a) = 0 +rank(a) = 1 +rank(a) = 2 +rank(a) = 3 +rank(a) = 4 +rank(a) = 5 +rank(a) = 6 +rank(a) = 7 +rank(a) = 8 +rank(a) = 9 +rank(a) = 10 +rank(a) = 11 +rank(a) = 12 +rank(a) = 13 +rank(a) = 14 +rank(a) = 15 +rank(a) = 0 +rank(a) = 1 +rank(a) = 2 +rank(a) = 3 +rank(a) = 4 +rank(a) = 5 +rank(a) = 6 +rank(a) = 7 +rank(a) = 8 +rank(a) = 9 +rank(a) = 10 +rank(a) = 11 +rank(a) = 12 +rank(a) = 13 +rank(a) = 14 +rank(a) = 15 +rank(a) = 0 +rank(a) = 1 +rank(a) = 2 +rank(a) = 3 +rank(a) = 4 +rank(a) = 5 +rank(a) = 6 +rank(a) = 7 +rank(a) = 8 +rank(a) = 9 +rank(a) = 10 +rank(a) = 11 +rank(a) = 12 +rank(a) = 13 +rank(a) = 14 +rank(a) = 15 +rank(a) = 0 +rank(a) = 1 +rank(a) = 2 +rank(a) = 3 +rank(a) = 4 +rank(a) = 5 +rank(a) = 6 +rank(a) = 7 +rank(a) = 8 +rank(a) = 9 +rank(a) = 10 +rank(a) = 11 +rank(a) = 12 +rank(a) = 13 +rank(a) = 14 +rank(a) = 15 +rank(a) = 0 +rank(a) = 1 +rank(a) = 2 +rank(a) = 3 +rank(a) = 4 +rank(a) = 5 +rank(a) = 6 +rank(a) = 7 +rank(a) = 8 +rank(a) = 9 +rank(a) = 10 +rank(a) = 11 +rank(a) = 12 +rank(a) = 13 +rank(a) = 14 +rank(a) = 15 +Assumed rank arg with contiguous and target attribute is contiguous +Assumed rank arg with contiguous and target attribute is contiguous +Assumed rank arg with contiguous and target attribute is contiguous +exit 0 diff --git a/Fortran/UnitTests/assumed-rank/lit.local.cfg b/Fortran/UnitTests/assumed-rank/lit.local.cfg new file mode 100644 index 0000000000..1166820260 --- /dev/null +++ b/Fortran/UnitTests/assumed-rank/lit.local.cfg @@ -0,0 +1,2 @@ +config.traditional_output = True +config.single_source = True