aboutsummaryrefslogtreecommitdiff
path: root/gcc/testsuite/gfortran.dg
diff options
context:
space:
mode:
Diffstat (limited to 'gcc/testsuite/gfortran.dg')
-rw-r--r--gcc/testsuite/gfortran.dg/alloc_comp_auto_array_3.f904
-rw-r--r--gcc/testsuite/gfortran.dg/alloc_comp_class_3.f033
-rw-r--r--gcc/testsuite/gfortran.dg/alloc_comp_class_4.f035
-rw-r--r--gcc/testsuite/gfortran.dg/allocate_with_mold_5.f9051
-rw-r--r--gcc/testsuite/gfortran.dg/allocate_with_source_14.f032
-rw-r--r--gcc/testsuite/gfortran.dg/asan/array_constructor_1.f9023
-rw-r--r--gcc/testsuite/gfortran.dg/asan/finalize_1.f9067
-rw-r--r--gcc/testsuite/gfortran.dg/c_f_pointer_tests_6.f902
-rw-r--r--gcc/testsuite/gfortran.dg/coarray/coindexed_6.f9024
-rw-r--r--gcc/testsuite/gfortran.dg/coarray/coindexed_7.f9024
-rw-r--r--gcc/testsuite/gfortran.dg/coarray_data_2.f9014
-rw-r--r--gcc/testsuite/gfortran.dg/comma_format_extension_1.f2
-rw-r--r--gcc/testsuite/gfortran.dg/comma_format_extension_3.f2
-rw-r--r--gcc/testsuite/gfortran.dg/continuation_13.f902
-rw-r--r--gcc/testsuite/gfortran.dg/dec_math.f9069
-rw-r--r--gcc/testsuite/gfortran.dg/dec_math_3.f9015
-rw-r--r--gcc/testsuite/gfortran.dg/dec_math_5.f9063
-rw-r--r--gcc/testsuite/gfortran.dg/dec_math_6.f9012
-rw-r--r--gcc/testsuite/gfortran.dg/derived_constructor_comps_6.f902
-rw-r--r--gcc/testsuite/gfortran.dg/derived_result_5.f90123
-rw-r--r--gcc/testsuite/gfortran.dg/diagnostic-format-json-1.F9024
-rw-r--r--gcc/testsuite/gfortran.dg/diagnostic-format-json-2.F9026
-rw-r--r--gcc/testsuite/gfortran.dg/diagnostic-format-json-3.F9026
-rw-r--r--gcc/testsuite/gfortran.dg/diagnostic-format-json-pr105916.F9014
-rw-r--r--gcc/testsuite/gfortran.dg/do_concurrent_basic.f907
-rw-r--r--gcc/testsuite/gfortran.dg/goacc/acc-wait-1.f9047
-rw-r--r--gcc/testsuite/gfortran.dg/gomp/omp_get_num_devices_initial_device-2.f9021
-rw-r--r--gcc/testsuite/gfortran.dg/gomp/omp_get_num_devices_initial_device.f9024
-rw-r--r--gcc/testsuite/gfortran.dg/guality/arg1.f902
-rw-r--r--gcc/testsuite/gfortran.dg/guality/pr120193.f9026
-rw-r--r--gcc/testsuite/gfortran.dg/inline_matmul_16.f902
-rw-r--r--gcc/testsuite/gfortran.dg/inline_matmul_26.f9036
-rw-r--r--gcc/testsuite/gfortran.dg/inquiry_type_ref_7.f9062
-rw-r--r--gcc/testsuite/gfortran.dg/inquiry_type_ref_8.f90214
-rw-r--r--gcc/testsuite/gfortran.dg/interface_60.f9070
-rw-r--r--gcc/testsuite/gfortran.dg/interface_61.f9027
-rw-r--r--gcc/testsuite/gfortran.dg/interface_62.f9039
-rw-r--r--gcc/testsuite/gfortran.dg/interface_63.f9097
-rw-r--r--gcc/testsuite/gfortran.dg/move_alloc_20.f03151
-rw-r--r--gcc/testsuite/gfortran.dg/non_lvalue_1.f9032
-rw-r--r--gcc/testsuite/gfortran.dg/pr119856.f9015
-rw-r--r--gcc/testsuite/gfortran.dg/pr119948.f9051
-rw-r--r--gcc/testsuite/gfortran.dg/pr120049_2.f9062
-rw-r--r--gcc/testsuite/gfortran.dg/pr120049_a.f9018
-rw-r--r--gcc/testsuite/gfortran.dg/pr120049_b.f906
-rw-r--r--gcc/testsuite/gfortran.dg/pr120152_1.f9052
-rw-r--r--gcc/testsuite/gfortran.dg/pr120152_2.f9080
-rw-r--r--gcc/testsuite/gfortran.dg/pr120153.f9036
-rw-r--r--gcc/testsuite/gfortran.dg/pr120158.f9015
-rw-r--r--gcc/testsuite/gfortran.dg/pr120191_1.f90614
-rw-r--r--gcc/testsuite/gfortran.dg/pr120191_2.f9084
-rw-r--r--gcc/testsuite/gfortran.dg/pr120191_3.f9023
-rw-r--r--gcc/testsuite/gfortran.dg/pr120196.f9026
-rw-r--r--gcc/testsuite/gfortran.dg/pr120743.f9038
-rw-r--r--gcc/testsuite/gfortran.dg/save_8.f9013
-rw-r--r--gcc/testsuite/gfortran.dg/save_alloc_character_1.f9023
-rw-r--r--gcc/testsuite/gfortran.dg/select_type_51.f9037
-rw-r--r--gcc/testsuite/gfortran.dg/stat_3.f9046
-rw-r--r--gcc/testsuite/gfortran.dg/transfer_array_subref.f9048
59 files changed, 2624 insertions, 119 deletions
diff --git a/gcc/testsuite/gfortran.dg/alloc_comp_auto_array_3.f90 b/gcc/testsuite/gfortran.dg/alloc_comp_auto_array_3.f90
index 2af089e..d0751f3 100644
--- a/gcc/testsuite/gfortran.dg/alloc_comp_auto_array_3.f90
+++ b/gcc/testsuite/gfortran.dg/alloc_comp_auto_array_3.f90
@@ -25,6 +25,6 @@ contains
allocate (array(1)%bigarr)
end function
end
-! { dg-final { scan-tree-dump-times "builtin_malloc" 3 "original" } }
+! { dg-final { scan-tree-dump-times "builtin_malloc" 4 "original" } }
! { dg-final { scan-tree-dump-times "builtin_free" 3 "original" } }
-! { dg-final { scan-tree-dump-times "while \\(1\\)" 4 "original" } }
+! { dg-final { scan-tree-dump-times "while \\(1\\)" 5 "original" } }
diff --git a/gcc/testsuite/gfortran.dg/alloc_comp_class_3.f03 b/gcc/testsuite/gfortran.dg/alloc_comp_class_3.f03
index 0753e33..8202d78 100644
--- a/gcc/testsuite/gfortran.dg/alloc_comp_class_3.f03
+++ b/gcc/testsuite/gfortran.dg/alloc_comp_class_3.f03
@@ -45,11 +45,10 @@ contains
type(c), value :: d
end subroutine
- type(c) function c_init() ! { dg-warning "not set" }
+ type(c) function c_init()
end function
subroutine sub(d)
type(u), value :: d
end subroutine
end program test_pr58586
-
diff --git a/gcc/testsuite/gfortran.dg/alloc_comp_class_4.f03 b/gcc/testsuite/gfortran.dg/alloc_comp_class_4.f03
index 4a55d73..9ff38e3 100644
--- a/gcc/testsuite/gfortran.dg/alloc_comp_class_4.f03
+++ b/gcc/testsuite/gfortran.dg/alloc_comp_class_4.f03
@@ -51,14 +51,14 @@ contains
type(t), value :: d
end subroutine
- type(c) function c_init() ! { dg-warning "not set" }
+ type(c) function c_init()
end function
class(c) function c_init2() ! { dg-warning "not set" }
allocatable :: c_init2
end function
- type(c) function d_init(this) ! { dg-warning "not set" }
+ type(c) function d_init(this)
class(d) :: this
end function
@@ -102,4 +102,3 @@ program test_pr58586
call add_c(oe%init())
deallocate(oe)
end program
-
diff --git a/gcc/testsuite/gfortran.dg/allocate_with_mold_5.f90 b/gcc/testsuite/gfortran.dg/allocate_with_mold_5.f90
new file mode 100644
index 0000000..f5e2fc9
--- /dev/null
+++ b/gcc/testsuite/gfortran.dg/allocate_with_mold_5.f90
@@ -0,0 +1,51 @@
+! { dg-do compile }
+! { dg-additional-options "-Wsurprising" }
+!
+! PR fortran/51961 - fix checking of MOLD= in ALLOCATE statements
+!
+! Contributed by Tobias Burnus
+
+program p
+ implicit none
+ type t
+ end type t
+ type u
+ class(t), allocatable :: a(:), b(:,:), c
+ end type u
+ class(T), allocatable :: a(:), b(:,:), c
+ type(u) :: z
+
+ allocate (b(2,2))
+ allocate (z% b(2,2))
+
+ allocate (a(2), mold=b(:,1))
+ allocate (a(1:2), mold=b(1,:))
+ allocate (a(2), mold=b) ! { dg-warning "but MOLD= expression at" }
+ allocate (a(1:2), mold=b) ! { dg-warning "but MOLD= expression at" }
+ allocate (z% a(2), mold=b(:,1))
+ allocate (z% a(1:2), mold=b(1,:))
+ allocate (z% a(2), mold=b) ! { dg-warning "but MOLD= expression at" }
+ allocate (z% a(1:2), mold=b) ! { dg-warning "but MOLD= expression at" }
+ allocate (z% a(2), mold=z% b(:,1))
+ allocate (z% a(1:2), mold=z% b(1,:))
+ allocate (z% a(2), mold=z% b) ! { dg-warning "but MOLD= expression at" }
+ allocate (z% a(1:2), mold=z% b) ! { dg-warning "but MOLD= expression at" }
+
+ allocate (c, mold=b(1,1))
+ allocate (c, mold=b) ! { dg-warning "but MOLD= expression at" }
+ allocate (z% c, mold=b(1,1))
+ allocate (z% c, mold=b) ! { dg-warning "but MOLD= expression at" }
+ allocate (z% c, mold=z% b(1,1))
+ allocate (z% c, mold=z% b) ! { dg-warning "but MOLD= expression at" }
+
+ allocate (a, mold=b(:,1))
+ allocate (a, mold=b(1,:))
+ allocate (z% a, mold=b(:,1))
+ allocate (z% a, mold=b(1,:))
+ allocate (z% a, mold=z% b(:,1))
+ allocate (z% a, mold=z% b(1,:))
+
+ allocate (a, mold=b) ! { dg-error "or have the same rank" }
+ allocate (z% a, mold=b) ! { dg-error "or have the same rank" }
+ allocate (z% a, mold=z% b) ! { dg-error "or have the same rank" }
+end
diff --git a/gcc/testsuite/gfortran.dg/allocate_with_source_14.f03 b/gcc/testsuite/gfortran.dg/allocate_with_source_14.f03
index fd2db74..36c1245 100644
--- a/gcc/testsuite/gfortran.dg/allocate_with_source_14.f03
+++ b/gcc/testsuite/gfortran.dg/allocate_with_source_14.f03
@@ -210,5 +210,5 @@ program main
call v%free()
deallocate(av)
end program
-! { dg-final { scan-tree-dump-times "__builtin_malloc" 22 "original" } }
+! { dg-final { scan-tree-dump-times "__builtin_malloc" 23 "original" } }
! { dg-final { scan-tree-dump-times "__builtin_free" 29 "original" } }
diff --git a/gcc/testsuite/gfortran.dg/asan/array_constructor_1.f90 b/gcc/testsuite/gfortran.dg/asan/array_constructor_1.f90
new file mode 100644
index 0000000..45eafac
--- /dev/null
+++ b/gcc/testsuite/gfortran.dg/asan/array_constructor_1.f90
@@ -0,0 +1,23 @@
+!{ dg-do run }
+
+! Contributed by Christopher Albert <albert@tugraz.at>
+
+program grow_type_array
+ type :: container
+ integer, allocatable :: arr(:)
+ end type container
+
+ type(container), allocatable :: list(:)
+
+ list = [list, new_elem(5)]
+
+ deallocate(list)
+
+contains
+
+ type(container) function new_elem(s) result(out)
+ integer :: s
+ allocate(out%arr(s))
+ end function new_elem
+
+end program grow_type_array
diff --git a/gcc/testsuite/gfortran.dg/asan/finalize_1.f90 b/gcc/testsuite/gfortran.dg/asan/finalize_1.f90
new file mode 100644
index 0000000..ab53a9e
--- /dev/null
+++ b/gcc/testsuite/gfortran.dg/asan/finalize_1.f90
@@ -0,0 +1,67 @@
+!{ dg-do run }
+
+! PR fortran/120637
+
+! Contributed by Antony Lewis <antony@cosmologist.info>
+! The unused module is needed to trigger the issue of not freeing the
+! memory of second module.
+
+ module MiscUtils
+ implicit none
+
+ contains
+
+ logical function isFloat0(R)
+ class(*), intent(in) :: R
+
+ select type(R)
+ type is (real)
+ isFloat0 = .true.
+ end select
+ end function isFloat0
+
+ end module MiscUtils
+
+ module results3
+ implicit none
+ public
+
+ Type ClTransferData2
+ real, dimension(:,:,:), allocatable :: Delta_p_l_k
+ end type ClTransferData2
+
+ type TCLdata2
+ Type(ClTransferData2) :: CTransScal, CTransTens, CTransVec
+ end type TCLdata2
+
+ type :: CAMBdata2
+ Type(TClData2) :: CLdata2
+ end type
+
+ end module results3
+
+program driver
+ use results3
+ integer i
+ do i=1, 2
+ call test()
+ end do
+
+ contains
+
+ subroutine test
+ implicit none
+ class(CAMBdata2), pointer :: Data
+
+ allocate(CAMBdata2::Data)
+
+ allocate(Data%ClData2%CTransScal%Delta_p_l_k(3, 1000, 1000))
+ allocate(Data%ClData2%CTransVec%Delta_p_l_k(3, 1000, 1000))
+ deallocate(Data)
+
+ end subroutine test
+
+ end program driver
+
+!{ dg-final { cleanup-modules "miscutils results3" } }
+
diff --git a/gcc/testsuite/gfortran.dg/c_f_pointer_tests_6.f90 b/gcc/testsuite/gfortran.dg/c_f_pointer_tests_6.f90
index 23ca88b..bc2206d 100644
--- a/gcc/testsuite/gfortran.dg/c_f_pointer_tests_6.f90
+++ b/gcc/testsuite/gfortran.dg/c_f_pointer_tests_6.f90
@@ -38,6 +38,6 @@ contains
type(my_c_ptr_0) :: my_ptr2
type(c_funptr) :: myfun
print *,c_associated(my_ptr,my_ptr2)
- print *,c_associated(my_ptr,myfun) ! { dg-error "Argument C_PTR_2 at .1. to C_ASSOCIATED shall have the same type as C_PTR_1: TYPE.c_ptr. instead of TYPE.c_funptr." }
+ print *,c_associated(my_ptr,myfun) ! { dg-error "Argument C_PTR_2 at .1. to C_ASSOCIATED shall have the same type as C_PTR_1, found TYPE.c_funptr. instead of TYPE.c_ptr." }
end subroutine
end
diff --git a/gcc/testsuite/gfortran.dg/coarray/coindexed_6.f90 b/gcc/testsuite/gfortran.dg/coarray/coindexed_6.f90
new file mode 100644
index 0000000..d566c504
--- /dev/null
+++ b/gcc/testsuite/gfortran.dg/coarray/coindexed_6.f90
@@ -0,0 +1,24 @@
+!{ dg-do compile }
+
+! Check PR120843 is fixed
+
+program p
+ implicit none
+
+ type T
+ integer, allocatable :: arr(:,:) [:,:]
+ end type
+
+ type(T) :: o
+ integer, allocatable :: vec(:)[:,:]
+ integer :: c[*]
+
+ c = 7
+
+ allocate(o%arr(4,3)[2,*], source=6)
+ allocate(vec(10)[1,*], source=7)
+
+ if (vec(3) * c /= 49) stop 1
+ if (o%arr(2,2)* c /= 42) stop 2
+
+end program p
diff --git a/gcc/testsuite/gfortran.dg/coarray/coindexed_7.f90 b/gcc/testsuite/gfortran.dg/coarray/coindexed_7.f90
new file mode 100644
index 0000000..0663970
--- /dev/null
+++ b/gcc/testsuite/gfortran.dg/coarray/coindexed_7.f90
@@ -0,0 +1,24 @@
+!{ dg-do compile }
+
+! Check PR120847 is fixed.
+
+program p
+ implicit none
+
+ type T
+ integer, allocatable :: i(:, :) [:]
+ end type T
+
+ type(T) :: o
+ integer, allocatable :: c[:]
+ integer :: i
+
+ c = 7
+
+ allocate(o%i(4, 5)[*], source=6)
+
+ do i = 1, 4
+ c = o%i(mod(i, 2), mod(i, 3))[1]
+ end do
+
+end program p
diff --git a/gcc/testsuite/gfortran.dg/coarray_data_2.f90 b/gcc/testsuite/gfortran.dg/coarray_data_2.f90
new file mode 100644
index 0000000..bda57f3
--- /dev/null
+++ b/gcc/testsuite/gfortran.dg/coarray_data_2.f90
@@ -0,0 +1,14 @@
+! { dg-do compile }
+! { dg-additional-options "-fcoarray=lib -Warray-temporaries" }
+!
+! PR fortran/99838 - ICE due to missing locus with data statement for coarray
+!
+! Contributed by Gerhard Steinmetz
+
+program p
+ type t
+ integer :: a
+ end type
+ type(t) :: x(3)[*]
+ data x%a /1, 2, 3/ ! { dg-warning "Creating array temporary" }
+end
diff --git a/gcc/testsuite/gfortran.dg/comma_format_extension_1.f b/gcc/testsuite/gfortran.dg/comma_format_extension_1.f
index a3a5a98..c4b43f0 100644
--- a/gcc/testsuite/gfortran.dg/comma_format_extension_1.f
+++ b/gcc/testsuite/gfortran.dg/comma_format_extension_1.f
@@ -1,5 +1,5 @@
! { dg-do compile }
-! { dg-options "" }
+! { dg-options "-std=legacy" }
! test that the extension for a missing comma is accepted
subroutine mysub
diff --git a/gcc/testsuite/gfortran.dg/comma_format_extension_3.f b/gcc/testsuite/gfortran.dg/comma_format_extension_3.f
index 0b00224..9d974d6 100644
--- a/gcc/testsuite/gfortran.dg/comma_format_extension_3.f
+++ b/gcc/testsuite/gfortran.dg/comma_format_extension_3.f
@@ -3,7 +3,7 @@
! did do the correct thing at runtime.
! Note the missing , before i1 in the format.
! { dg-do run }
-! { dg-options "" }
+! { dg-options "-std=legacy" }
character*12 c
write (c,100) 0, 1
diff --git a/gcc/testsuite/gfortran.dg/continuation_13.f90 b/gcc/testsuite/gfortran.dg/continuation_13.f90
index 9799b59e..475c896 100644
--- a/gcc/testsuite/gfortran.dg/continuation_13.f90
+++ b/gcc/testsuite/gfortran.dg/continuation_13.f90
@@ -1,5 +1,5 @@
! { dg-do run }
-! { dg-options "-std=gnu" }
+! { dg-options "-std=legacy" }
! PR64506
character(25) :: astring
diff --git a/gcc/testsuite/gfortran.dg/dec_math.f90 b/gcc/testsuite/gfortran.dg/dec_math.f90
index 393e7de..79c1807 100644
--- a/gcc/testsuite/gfortran.dg/dec_math.f90
+++ b/gcc/testsuite/gfortran.dg/dec_math.f90
@@ -5,6 +5,12 @@
! Test extra math intrinsics formerly offered by -fdec-math,
! now included with -std=gnu or -std=legacy.
!
+! Since Fortran 2023, the degree trigonometric functions (sind, cosd, ...)
+! are part of the standard; additionally, Fortran 2023 added a two-argument
+! version of atand as alias for atan2d.
+!
+! Note that cotan and cotand are not part of Fortran 2023; hence, this file
+! still requires -std=gnu and cannot be compiled with -std=f2023.
module dec_math
@@ -522,6 +528,69 @@ call cmpq(q_i1, q_oxe, q_ox, q_tol, "(x) qatand")
#endif
! Input
+f_i1 = 1.0_4
+f_i2 = 2.0_4
+d_i1 = 1.0_8
+d_i2 = 2.0_8
+#ifdef __GFC_REAL_10__
+l_i1 = 1.0_10
+l_i2 = 2.0_10
+#endif
+#ifdef __GFC_REAL_16__
+q_i1 = 1.0_16
+q_i2 = 2.0_16
+#endif
+
+! Expected
+f_oe = r2d_f * atan2 (f_i1, f_i2)
+f_oxe = r2d_f * atan2 (xf * f_i1, f_i2)
+d_oe = r2d_d * atan2 (d_i1, d_i2)
+d_oxe = r2d_d * atan2 (xd * d_i1, d_i2)
+#ifdef __GFC_REAL_10__
+l_oe = r2d_l * atan2 (l_i1, l_i2)
+l_oxe = r2d_l * atan2 (xl * l_i1, l_i2)
+#endif
+#ifdef __GFC_REAL_16__
+q_oe = r2d_q * atan2 (q_i1, q_i2)
+q_oxe = r2d_q * atan2 (xq * q_i1, q_i2)
+#endif
+
+! Actual
+f_oa = atand (f_i1, f_i2)
+f_oc = atand (1.0_4, 2.0_4)
+f_ox = atand (xf * f_i1, f_i2)
+d_oa = atand (d_i1, d_i2)
+d_oc = atand (1.0_8, 2.0_8)
+d_ox = atand (xd * d_i1, d_i2)
+#ifdef __GFC_REAL_10__
+l_oa = atand (l_i1, l_i2)
+l_oc = atand (1.0_10, 2.0_10)
+l_ox = atand (xl * l_i1, l_i2)
+#endif
+#ifdef __GFC_REAL_16__
+q_oa = atand (q_i1, q_i2)
+q_oc = atand (1.0_16, 2.0_16)
+q_ox = atand (xq * q_i1, q_i2)
+#endif
+
+call cmpf(f_i1, f_oe, f_oa, f_tol, "( ) fatand")
+call cmpf(f_i1, f_oe, f_oc, f_tol, "(c) fatand")
+call cmpf(f_i1, f_oxe, f_ox, f_tol, "(x) fatand")
+call cmpd(d_i1, d_oe, d_oa, d_tol, "( ) datand")
+call cmpd(d_i1, d_oe, d_oc, d_tol, "(c) datand")
+call cmpd(d_i1, d_oxe, d_ox, d_tol, "(x) atand")
+#ifdef __GFC_REAL_10__
+call cmpl(l_i1, l_oe, l_oa, l_tol, "( ) latand")
+call cmpl(l_i1, l_oe, l_oc, l_tol, "(c) latand")
+call cmpl(l_i1, l_oxe, l_ox, l_tol, "(x) latand")
+#endif
+#ifdef __GFC_REAL_16__
+call cmpq(q_i1, q_oe, q_oa, q_tol, "( ) qatand")
+call cmpq(q_i1, q_oe, q_oc, q_tol, "(c) qatand")
+call cmpq(q_i1, q_oxe, q_ox, q_tol, "(x) qatand")
+#endif
+
+! Input
f_i1 = 34.3775_4
d_i1 = 34.3774677078494_8
#ifdef __GFC_REAL_10__
diff --git a/gcc/testsuite/gfortran.dg/dec_math_3.f90 b/gcc/testsuite/gfortran.dg/dec_math_3.f90
index 5bf4398..d2f57e2 100644
--- a/gcc/testsuite/gfortran.dg/dec_math_3.f90
+++ b/gcc/testsuite/gfortran.dg/dec_math_3.f90
@@ -1,8 +1,17 @@
! { dg-options "-std=gnu" }
! { dg-do compile }
-! Former ICE when simplifying asind, plus wrong function name in error message
-real, parameter :: d = asind(1.1) ! { dg-error "Argument of ASIND at.*must be between -1 and 1" }
-print *, d
+real, parameter :: dacos = acosd(1.1) ! { dg-error "Argument of ACOSD at .1. must be within the closed interval \\\[-1, 1\\\]" }
+print *, dacos
+real, parameter :: dasin = asind(-1.1) ! { dg-error "Argument of ASIND at .1. must be within the closed interval \\\[-1, 1\\\]" }
+print *, dasin
+real, parameter :: datan2 = atan2d(0.0, 0.0) ! { dg-error "If the first argument of ATAN2D at .1. is zero, then the second argument must not be zero" }
+print *, datan2
+real, parameter :: piacos = acospi(-1.1) ! { dg-error "Argument of ACOSPI at .1. must be within the closed interval \\\[-1, 1\\\]" }
+print *, piacos
+real, parameter :: piasin = asinpi(1.1) ! { dg-error "Argument of ASINPI at .1. must be within the closed interval \\\[-1, 1\\\]" }
+print *, piasin
+real, parameter :: piatan2 = atan2pi(0.0, 0.0) ! { dg-error "If the first argument of ATAN2PI at .1. is zero, then the second argument must not be zero" }
+print *, piatan2
end
diff --git a/gcc/testsuite/gfortran.dg/dec_math_5.f90 b/gcc/testsuite/gfortran.dg/dec_math_5.f90
index dee2de4..a7ff327 100644
--- a/gcc/testsuite/gfortran.dg/dec_math_5.f90
+++ b/gcc/testsuite/gfortran.dg/dec_math_5.f90
@@ -101,4 +101,67 @@ program p
if (abs(b1 - 0.5) > e2) stop 38
if (abs(c1 - 0.5) > e3) stop 39
if (abs(d1 - 0.5) > e4) stop 40
+
+ a1 = acospi(0.5)
+ b1 = acospi(-0.5)
+ c1 = acospi(0.5)
+ d1 = acospi(-0.5)
+ if (abs(a1 - 1.0 / 3) > e1) stop 41
+ if (abs(b1 - 2.0 / 3) > e2) stop 42
+ if (abs(c1 - 1.0 / 3) > e3) stop 43
+ if (abs(d1 - 2.0 / 3) > e4) stop 44
+
+ a1 = asinpi(0.5)
+ b1 = asinpi(-0.5)
+ c1 = asinpi(0.5)
+ d1 = asinpi(-0.5)
+ if (abs(a1 - 1.0 / 6) > e1) stop 45
+ if (abs(b1 + 1.0 / 6) > e2) stop 46
+ if (abs(c1 - 1.0 / 6) > e3) stop 47
+ if (abs(d1 + 1.0 / 6) > e4) stop 48
+
+ a1 = atanpi(1.0)
+ b1 = atanpi(-1.0)
+ c1 = atanpi(1.0)
+ d1 = atanpi(-1.0)
+ if (abs(a1 - 0.25) > e1) stop 49
+ if (abs(b1 + 0.25) > e2) stop 50
+ if (abs(c1 - 0.25) > e3) stop 51
+ if (abs(d1 + 0.25) > e4) stop 52
+
+ a1 = atan2pi(1.0, 1.0)
+ b1 = atan2pi(1.0, 1.0)
+ c1 = atan2pi(1.0, 1.0)
+ d1 = atan2pi(1.0, 1.0)
+ if (abs(a1 - 0.25) > e1) stop 53
+ if (abs(b1 - 0.25) > e2) stop 54
+ if (abs(c1 - 0.25) > e3) stop 55
+ if (abs(d1 - 0.25) > e4) stop 56
+
+ a1 = cospi(1._4 / 3)
+ b1 = cospi(-1._8 / 3)
+ c1 = cospi(4._ep / 3)
+ d1 = cospi(-4._16 / 3)
+ if (abs(a1 - 0.5) > e1) stop 57
+ if (abs(b1 - 0.5) > e2) stop 58
+ if (abs(c1 + 0.5) > e3) stop 59
+ if (abs(d1 + 0.5) > e4) stop 60
+
+ a1 = sinpi(1._4 / 6)
+ b1 = sinpi(-1._8 / 6)
+ c1 = sinpi(5._ep / 6)
+ d1 = sinpi(-7._16 / 6)
+ if (abs(a1 - 0.5) > e1) stop 61
+ if (abs(b1 + 0.5) > e2) stop 62
+ if (abs(c1 - 0.5) > e3) stop 63
+ if (abs(d1 - 0.5) > e4) stop 64
+
+ a1 = tanpi(0.25)
+ b1 = tanpi(-0.25)
+ c1 = tanpi(1.25)
+ d1 = tanpi(-1.25)
+ if (abs(a1 - 1.0) > e1) stop 65
+ if (abs(b1 + 1.0) > e2) stop 66
+ if (abs(c1 - 1.0) > e3) stop 67
+ if (abs(d1 + 1.0) > e4) stop 68
end program p
diff --git a/gcc/testsuite/gfortran.dg/dec_math_6.f90 b/gcc/testsuite/gfortran.dg/dec_math_6.f90
new file mode 100644
index 0000000..dfb8b06
--- /dev/null
+++ b/gcc/testsuite/gfortran.dg/dec_math_6.f90
@@ -0,0 +1,12 @@
+! { dg-options "-std=f2018" }
+! { dg-do compile }
+
+intrinsic :: acospi ! { dg-error "The intrinsic 'acospi' declared INTRINSIC at .1. is not available in the current standard settings but new in Fortran 2023. Use an appropriate '-std=\\*' option or enable '-fall-intrinsics' in order to use it" }
+intrinsic :: asinpi ! { dg-error "The intrinsic 'asinpi' declared INTRINSIC at .1. is not available in the current standard settings but new in Fortran 2023. Use an appropriate '-std=\\*' option or enable '-fall-intrinsics' in order to use it" }
+intrinsic :: atanpi ! { dg-error "The intrinsic 'atanpi' declared INTRINSIC at .1. is not available in the current standard settings but new in Fortran 2023. Use an appropriate '-std=\\*' option or enable '-fall-intrinsics' in order to use it" }
+intrinsic :: atan2pi ! { dg-error "The intrinsic 'atan2pi' declared INTRINSIC at .1. is not available in the current standard settings but new in Fortran 2023. Use an appropriate '-std=\\*' option or enable '-fall-intrinsics' in order to use it" }
+intrinsic :: cospi ! { dg-error "The intrinsic 'cospi' declared INTRINSIC at .1. is not available in the current standard settings but new in Fortran 2023. Use an appropriate '-std=\\*' option or enable '-fall-intrinsics' in order to use it" }
+intrinsic :: sinpi ! { dg-error "The intrinsic 'sinpi' declared INTRINSIC at .1. is not available in the current standard settings but new in Fortran 2023. Use an appropriate '-std=\\*' option or enable '-fall-intrinsics' in order to use it" }
+intrinsic :: tanpi ! { dg-error "The intrinsic 'tanpi' declared INTRINSIC at .1. is not available in the current standard settings but new in Fortran 2023. Use an appropriate '-std=\\*' option or enable '-fall-intrinsics' in order to use it" }
+
+end
diff --git a/gcc/testsuite/gfortran.dg/derived_constructor_comps_6.f90 b/gcc/testsuite/gfortran.dg/derived_constructor_comps_6.f90
index bdfa47b..406e031 100644
--- a/gcc/testsuite/gfortran.dg/derived_constructor_comps_6.f90
+++ b/gcc/testsuite/gfortran.dg/derived_constructor_comps_6.f90
@@ -129,5 +129,5 @@ contains
prt_spec = name
end function new_prt_spec3
end program main
-! { dg-final { scan-tree-dump-times "__builtin_malloc" 15 "original" } }
+! { dg-final { scan-tree-dump-times "__builtin_malloc" 16 "original" } }
! { dg-final { scan-tree-dump-times "__builtin_free" 33 "original" } }
diff --git a/gcc/testsuite/gfortran.dg/derived_result_5.f90 b/gcc/testsuite/gfortran.dg/derived_result_5.f90
new file mode 100644
index 0000000..1ba4d19
--- /dev/null
+++ b/gcc/testsuite/gfortran.dg/derived_result_5.f90
@@ -0,0 +1,123 @@
+! { dg-do run }
+! { dg-additional-options "-O2 -Wreturn-type" }
+!
+! PR fortran/85750 - default-initialization and functions returning derived type
+
+module bar
+ implicit none
+ type ilist
+ integer :: count = 42
+ integer, pointer :: ptr(:) => null()
+ end type ilist
+
+ type jlist
+ real, allocatable :: a(:)
+ integer :: count = 23
+ end type jlist
+
+contains
+
+ function make_list(i)
+ integer, intent(in) :: i
+ type(ilist), dimension(2) :: make_list
+ make_list(i)%count = i
+ end function make_list
+
+ function make_list_res(i) result(list)
+ integer, intent(in) :: i
+ type(ilist), dimension(2) :: list
+ list(i)%count = i
+ end function make_list_res
+
+ function make_jlist(i)
+ integer, intent(in) :: i
+ type(jlist), dimension(2) :: make_jlist
+ make_jlist(i)%count = i
+ end function make_jlist
+
+ function make_jlist_res(i) result(list)
+ integer, intent(in) :: i
+ type(jlist), dimension(2) :: list
+ list(i)%count = i
+ end function make_jlist_res
+
+ function empty_ilist()
+ type(ilist), dimension(2) :: empty_ilist
+ end function
+
+ function empty_jlist()
+ type(jlist), dimension(2) :: empty_jlist
+ end function
+
+ function empty_ilist_res() result (res)
+ type(ilist), dimension(2) :: res
+ end function
+
+ function empty_jlist_res() result (res)
+ type(jlist), dimension(2) :: res
+ end function
+
+end module bar
+
+program foo
+ use bar
+ implicit none
+ type(ilist) :: mylist(2) = ilist(count=-2)
+ type(jlist), allocatable :: yourlist(:)
+
+ mylist = ilist(count=-1)
+ if (any (mylist%count /= [-1,-1])) stop 1
+ mylist = empty_ilist()
+ if (any (mylist%count /= [42,42])) stop 2
+ mylist = ilist(count=-1)
+ mylist = empty_ilist_res()
+ if (any (mylist%count /= [42,42])) stop 3
+
+ allocate(yourlist(1:2))
+ if (any (yourlist%count /= [23,23])) stop 4
+ yourlist = jlist(count=-1)
+ if (any (yourlist%count /= [-1,-1])) stop 5
+ yourlist = empty_jlist()
+ if (any (yourlist%count /= [23,23])) stop 6
+ yourlist = jlist(count=-1)
+ yourlist = empty_jlist_res()
+ if (any (yourlist%count /= [23,23])) stop 7
+
+ mylist = make_list(1)
+ if (any (mylist%count /= [1,42])) stop 11
+ mylist = make_list(2)
+ if (any (mylist%count /= [42,2])) stop 12
+ mylist = (make_list(1))
+ if (any (mylist%count /= [1,42])) stop 13
+ mylist = [make_list(2)]
+ if (any (mylist%count /= [42,2])) stop 14
+
+ mylist = make_list_res(1)
+ if (any (mylist%count /= [1,42])) stop 21
+ mylist = make_list_res(2)
+ if (any (mylist%count /= [42,2])) stop 22
+ mylist = (make_list_res(1))
+ if (any (mylist%count /= [1,42])) stop 23
+ mylist = [make_list_res(2)]
+ if (any (mylist%count /= [42,2])) stop 24
+
+ yourlist = make_jlist(1)
+ if (any (yourlist%count /= [1,23])) stop 31
+ yourlist = make_jlist(2)
+ if (any (yourlist%count /= [23,2])) stop 32
+ yourlist = (make_jlist(1))
+ if (any (yourlist%count /= [1,23])) stop 33
+ yourlist = [make_jlist(2)]
+ if (any (yourlist%count /= [23,2])) stop 34
+
+ yourlist = make_jlist_res(1)
+ if (any (yourlist%count /= [1,23])) stop 41
+ yourlist = make_jlist_res(2)
+ if (any (yourlist%count /= [23,2])) stop 42
+ yourlist = (make_jlist_res(1))
+ if (any (yourlist%count /= [1,23])) stop 43
+ yourlist = [make_jlist_res(2)]
+ if (any (yourlist%count /= [23,2])) stop 44
+
+ deallocate (yourlist)
+end program foo
diff --git a/gcc/testsuite/gfortran.dg/diagnostic-format-json-1.F90 b/gcc/testsuite/gfortran.dg/diagnostic-format-json-1.F90
deleted file mode 100644
index b8cd61c..0000000
--- a/gcc/testsuite/gfortran.dg/diagnostic-format-json-1.F90
+++ /dev/null
@@ -1,24 +0,0 @@
-! { dg-do compile }
-! { dg-options "-fdiagnostics-format=json" }
-
-#error message
-
-#if 0
-{ dg-begin-multiline-output "" }
-[{"kind": "error",
- "message": "#error message",
- "children": [],
- "column-origin": 1,
- "locations": [{"caret": {"file":
- "line": 4,
- "display-column": 2,
- "byte-column": 2,
- "column": 2},
- "finish": {"file":
- "line": 4,
- "display-column": 6,
- "byte-column": 6,
- "column": 6}}],
- "escape-source": false}]
-{ dg-end-multiline-output "" }
-#endif
diff --git a/gcc/testsuite/gfortran.dg/diagnostic-format-json-2.F90 b/gcc/testsuite/gfortran.dg/diagnostic-format-json-2.F90
deleted file mode 100644
index 9ff1ef5..0000000
--- a/gcc/testsuite/gfortran.dg/diagnostic-format-json-2.F90
+++ /dev/null
@@ -1,26 +0,0 @@
-! { dg-do compile }
-! { dg-options "-fdiagnostics-format=json" }
-
-#warning message
-
-#if 0
-{ dg-begin-multiline-output "" }
-[{"kind": "warning",
- "message": "#warning message",
- "option": "-Wcpp",
- "option_url":
- "children": [],
- "column-origin": 1,
- "locations": [{"caret": {"file":
- "line": 4,
- "display-column": 2,
- "byte-column": 2,
- "column": 2},
- "finish": {"file":
- "line": 4,
- "display-column": 8,
- "byte-column": 8,
- "column": 8}}],
- "escape-source": false}]
-{ dg-end-multiline-output "" }
-#endif
diff --git a/gcc/testsuite/gfortran.dg/diagnostic-format-json-3.F90 b/gcc/testsuite/gfortran.dg/diagnostic-format-json-3.F90
deleted file mode 100644
index 750e186..0000000
--- a/gcc/testsuite/gfortran.dg/diagnostic-format-json-3.F90
+++ /dev/null
@@ -1,26 +0,0 @@
-! { dg-do compile }
-! { dg-options "-fdiagnostics-format=json -Werror" }
-
-#warning message
-
-#if 0
-{ dg-begin-multiline-output "" }
-[{"kind": "error",
- "message": "#warning message",
- "option": "-Werror=cpp",
- "option_url":
- "children": [],
- "column-origin": 1,
- "locations": [{"caret": {"file":
- "line": 4,
- "display-column": 2,
- "byte-column": 2,
- "column": 2},
- "finish": {"file":
- "line": 4,
- "display-column": 8,
- "byte-column": 8,
- "column": 8}}],
- "escape-source": false}]
-{ dg-end-multiline-output "" }
-#endif
diff --git a/gcc/testsuite/gfortran.dg/diagnostic-format-json-pr105916.F90 b/gcc/testsuite/gfortran.dg/diagnostic-format-json-pr105916.F90
deleted file mode 100644
index bf22a86..0000000
--- a/gcc/testsuite/gfortran.dg/diagnostic-format-json-pr105916.F90
+++ /dev/null
@@ -1,14 +0,0 @@
-! { dg-do compile }
-! { dg-options "-fdiagnostics-format=json-stderr -fmax-errors=1 -Wfatal-errors" }
-
-program main
- implicit none
- print*, "Hello World!"
-end program main
-
-! We expect an empty array as the JSON output.
-#if 0
-{ dg-begin-multiline-output "" }
-[]
-{ dg-end-multiline-output "" }
-#endif
diff --git a/gcc/testsuite/gfortran.dg/do_concurrent_basic.f90 b/gcc/testsuite/gfortran.dg/do_concurrent_basic.f90
index fe8723d..bdb6e0e 100644
--- a/gcc/testsuite/gfortran.dg/do_concurrent_basic.f90
+++ b/gcc/testsuite/gfortran.dg/do_concurrent_basic.f90
@@ -1,4 +1,4 @@
-! { dg-do run }
+! { dg-do compile }
program basic_do_concurrent
implicit none
integer :: i, arr(10)
@@ -7,5 +7,8 @@ program basic_do_concurrent
arr(i) = i
end do
+ do concurrent (i=1:10);enddo
+ do,concurrent (i=1:10);arr(i)=i;enddo
+
print *, arr
-end program basic_do_concurrent \ No newline at end of file
+end program basic_do_concurrent
diff --git a/gcc/testsuite/gfortran.dg/goacc/acc-wait-1.f90 b/gcc/testsuite/gfortran.dg/goacc/acc-wait-1.f90
new file mode 100644
index 0000000..dd19b41
--- /dev/null
+++ b/gcc/testsuite/gfortran.dg/goacc/acc-wait-1.f90
@@ -0,0 +1,47 @@
+! { dg-do compile }
+! { dg-additional-options "-fdump-tree-original" }
+
+subroutine f0(x)
+ implicit none
+ integer, value :: x
+ !$acc wait(x) if(.false.) async
+end
+
+subroutine f1(y, ia)
+ implicit none
+ integer, value :: y, ia
+ !$acc wait(y) if(.true.) async(ia)
+end
+
+subroutine fl(z, ll)
+ implicit none
+ integer, value :: z
+ logical, value :: ll
+ !$acc wait(z) if(ll) async(3)
+end
+
+subroutine a0(a)
+ implicit none
+ integer, value :: a
+ !$acc wait(a) if(.false.)
+end
+
+subroutine a1(b)
+ implicit none
+ integer, value :: b
+ !$acc wait(b) if(.true.)
+end
+
+subroutine al(c, qq)
+ implicit none
+ integer, value :: c
+ logical, value :: qq
+ !$acc wait(c) if(qq)
+end
+
+! { dg-final { scan-tree-dump-times "D\.\[0-9\]+ = x;\[\\n\\r\]+ *if \\(0\\)\[\\n\\r\]+ *\{\[\\n\\r\]+ *__builtin_GOACC_wait \\(-1, 1, D\.\[0-9\]+\\);" 1 "original" } }
+! { dg-final { scan-tree-dump-times "D\.\[0-9\]+ = ia;\[\\n\\r\]+ *D\.\[0-9\]+ = y;\[\\n\\r\]+ *if \\(1\\)\[\\n\\r\]+ *\{\[\\n\\r\]+ *__builtin_GOACC_wait \\(D\.\[0-9\]+, 1, D\.\[0-9\]+\\);" 1 "original" } }
+! { dg-final { scan-tree-dump-times "D\.\[0-9\]+ = z;\[\\n\\r\]+ *D\.\[0-9\]+ = ll;\[\\n\\r\]+ *if \\(D\.\[0-9\]+\\)\[\\n\\r\]+ *\{\[\\n\\r\]+ *__builtin_GOACC_wait \\(3, 1, D\.\[0-9\]+\\);" 1 "original" } }
+! { dg-final { scan-tree-dump-times "D\.\[0-9\]+ = a;\[\\n\\r\]+ *if \\(0\\)\[\\n\\r\]+ *\{\[\\n\\r\]+ *__builtin_GOACC_wait \\(-2, 1, D\.\[0-9\]+\\);" 1 "original" } }
+! { dg-final { scan-tree-dump-times "D\.\[0-9\]+ = b;\[\\n\\r\]+ *if \\(1\\)\[\\n\\r\]+ *\{\[\\n\\r\]+ *__builtin_GOACC_wait \\(-2, 1, D\.\[0-9\]+\\);" 1 "original" } }
+! { dg-final { scan-tree-dump-times "D\.\[0-9\]+ = c;\[\\n\\r\]+ *D\.\[0-9\]+ = qq;\[\\n\\r\]+ *if \\(D\.\[0-9\]+\\)\[\\n\\r\]+ *\{\[\\n\\r\]+ *__builtin_GOACC_wait \\(-2, 1, D\.\[0-9\]+\\);" 1 "original" } }
diff --git a/gcc/testsuite/gfortran.dg/gomp/omp_get_num_devices_initial_device-2.f90 b/gcc/testsuite/gfortran.dg/gomp/omp_get_num_devices_initial_device-2.f90
new file mode 100644
index 0000000..18613d4
--- /dev/null
+++ b/gcc/testsuite/gfortran.dg/gomp/omp_get_num_devices_initial_device-2.f90
@@ -0,0 +1,21 @@
+! { dg-do compile }
+! { dg-additional-options "-O1 -fdump-tree-optimized -fno-builtin-omp_get_num_devices -fno-builtin-omp_get_initial_device" }
+integer function f() result(ret)
+ interface
+ integer function omp_get_initial_device (); end
+ integer function omp_get_num_devices (); end
+ end interface
+
+ if (omp_get_initial_device () /= omp_get_num_devices ()) error stop
+
+ if (omp_get_num_devices () /= omp_get_num_devices ()) error stop
+
+ if (omp_get_initial_device () /= omp_get_initial_device ()) error stop
+
+ ret = omp_get_num_devices ()
+end
+
+! { dg-final { scan-tree-dump-times "error_stop" 3 "optimized" } }
+
+! { dg-final { scan-tree-dump-times "omp_get_num_devices" 4 "optimized" } }
+! { dg-final { scan-tree-dump-times "omp_get_initial_device" 3 "optimized" } }
diff --git a/gcc/testsuite/gfortran.dg/gomp/omp_get_num_devices_initial_device.f90 b/gcc/testsuite/gfortran.dg/gomp/omp_get_num_devices_initial_device.f90
new file mode 100644
index 0000000..279656b
--- /dev/null
+++ b/gcc/testsuite/gfortran.dg/gomp/omp_get_num_devices_initial_device.f90
@@ -0,0 +1,24 @@
+! { dg-do compile }
+! { dg-additional-options "-O1 -fdump-tree-optimized" }
+integer function f() result(ret)
+ interface
+ integer function omp_get_initial_device (); end
+ integer function omp_get_num_devices (); end
+ end interface
+
+ if (omp_get_initial_device () /= omp_get_num_devices ()) error stop
+
+ if (omp_get_num_devices () /= omp_get_num_devices ()) error stop
+
+ if (omp_get_initial_device () /= omp_get_initial_device ()) error stop
+
+ ret = omp_get_num_devices ()
+end
+
+! { dg-final { scan-tree-dump-not "error_stop" "optimized" } }
+
+! { dg-final { scan-tree-dump-not "omp_get_num_devices" "optimized" { target { ! offloading_enabled } } } }
+! { dg-final { scan-tree-dump "return 0;" "optimized" { target { ! offloading_enabled } } } }
+
+! { dg-final { scan-tree-dump-times "omp_get_num_devices" 1 "optimized" { target offloading_enabled } } }
+! { dg-final { scan-tree-dump "_1 = __builtin_omp_get_num_devices \\(\\);\[\\r\\n\]+\[ \]+return _1;" "optimized" { target offloading_enabled } } }
diff --git a/gcc/testsuite/gfortran.dg/guality/arg1.f90 b/gcc/testsuite/gfortran.dg/guality/arg1.f90
index 332a4ed..775b7bb 100644
--- a/gcc/testsuite/gfortran.dg/guality/arg1.f90
+++ b/gcc/testsuite/gfortran.dg/guality/arg1.f90
@@ -1,5 +1,5 @@
! { dg-do run }
-! { dg-options "-g" }
+! { dg-options "-fno-shrink-wrap -g" }
integer :: a(10), b(12)
call sub (a, 10)
call sub (b, 12)
diff --git a/gcc/testsuite/gfortran.dg/guality/pr120193.f90 b/gcc/testsuite/gfortran.dg/guality/pr120193.f90
new file mode 100644
index 0000000..e65febf
--- /dev/null
+++ b/gcc/testsuite/gfortran.dg/guality/pr120193.f90
@@ -0,0 +1,26 @@
+! PR fortran/120193
+! { dg-do run }
+! { dg-options "-g -funsigned" }
+! { dg-skip-if "" { *-*-* } { "*" } { "-O0" } }
+
+program foo
+ unsigned(kind=1) :: a(2), e
+ unsigned(kind=2) :: b(2), f
+ unsigned(kind=4) :: c(2), g
+ unsigned(kind=8) :: d(2), h
+ character(kind=1, len=1) :: i(2), j
+ character(kind=4, len=1) :: k(2), l
+ a = 97u_1 ! { dg-final { gdb-test 24 "a" "d" } }
+ b = 97u_2 ! { dg-final { gdb-test 24 "b" "c" } }
+ c = 97u_4 ! { dg-final { gdb-test 24 "c" "b" } }
+ d = 97u_8 ! { dg-final { gdb-test 24 "d" "a" } }
+ e = 97u_1 ! { dg-final { gdb-test 24 "e" "97" } }
+ f = 97u_2 ! { dg-final { gdb-test 24 "f" "97" } }
+ g = 97u_4 ! { dg-final { gdb-test 24 "g" "97" } }
+ h = 97u_8 ! { dg-final { gdb-test 24 "h" "97" } }
+ i = 'a' ! { dg-final { gdb-test 24 "i" "('a', 'a')" } }
+ j = 'b' ! { dg-final { gdb-test 24 "j" "'b'" } }
+ k = 'c'
+ l = 'd'
+ print *, a
+end program
diff --git a/gcc/testsuite/gfortran.dg/inline_matmul_16.f90 b/gcc/testsuite/gfortran.dg/inline_matmul_16.f90
index 580cb1a..bb1a3cb 100644
--- a/gcc/testsuite/gfortran.dg/inline_matmul_16.f90
+++ b/gcc/testsuite/gfortran.dg/inline_matmul_16.f90
@@ -58,4 +58,4 @@ program main
end do
end do
end program main
-! { dg-final { scan-tree-dump-times "_gfortran_matmul" 1 "optimized" } }
+! { dg-final { scan-tree-dump-not "_gfortran_matmul" "optimized" } }
diff --git a/gcc/testsuite/gfortran.dg/inline_matmul_26.f90 b/gcc/testsuite/gfortran.dg/inline_matmul_26.f90
new file mode 100644
index 0000000..0876941
--- /dev/null
+++ b/gcc/testsuite/gfortran.dg/inline_matmul_26.f90
@@ -0,0 +1,36 @@
+! { dg-do run }
+! { dg-options "-ffrontend-optimize -fdump-tree-optimized -Wrealloc-lhs -finline-matmul-limit=1000 -O" }
+! PR 66094: Check functionality for MATMUL(TRANSPOSE(A),B)) for two-dimensional arrays
+program main
+ implicit none
+ integer :: in, im, icnt
+ integer, volatile :: ten
+
+ ten = 10
+ ! cycle through a few test cases...
+ do in = 2,ten
+ do im = 2,ten
+ do icnt = 2,ten
+ block
+ real, dimension(icnt,in) :: a2
+ real, dimension(icnt,im) :: b2
+ real, dimension(in,im) :: c2,cr
+ integer :: i,j,k
+ call random_number(a2)
+ call random_number(b2)
+ c2 = 0
+ do i=1,size(a2,2)
+ do j=1, size(b2,2)
+ do k=1, size(a2,1)
+ c2(i,j) = c2(i,j) + a2(k,i) * b2(k,j)
+ end do
+ end do
+ end do
+ cr = matmul(transpose(a2), b2)
+ if (any(abs(c2-cr) > 1e-4)) STOP 7
+ end block
+ end do
+ end do
+ end do
+end program main
+! { dg-final { scan-tree-dump-times "_gfortran_matmul" 1 "optimized" } }
diff --git a/gcc/testsuite/gfortran.dg/inquiry_type_ref_7.f90 b/gcc/testsuite/gfortran.dg/inquiry_type_ref_7.f90
new file mode 100644
index 0000000..534225a
--- /dev/null
+++ b/gcc/testsuite/gfortran.dg/inquiry_type_ref_7.f90
@@ -0,0 +1,62 @@
+! { dg-do compile }
+! { dg-additional-options "-fdump-tree-original" }
+!
+! PR fortran/101735 - substrings and parsing of type parameter inquiries
+
+program p
+ implicit none
+ integer, parameter :: ck = 4
+ character(len=5) :: str = ""
+ character(len=5) :: str2(4)
+ character(len=5,kind=ck) :: str4 = ck_""
+ type t
+ character(len=5) :: str(4)
+ end type t
+ type(t) :: var
+ integer :: x, y
+
+ integer, parameter :: i1 = kind (str(1:3))
+ integer, parameter :: j1 = str (1:3) % kind
+ integer, parameter :: k1 = (str(1:3) % kind)
+ integer, parameter :: kk = str (1:3) % kind % kind
+
+ integer, parameter :: i4 = kind (str4(1:3))
+ integer, parameter :: j4 = str4 (1:3) % kind
+ integer, parameter :: ll = str4 (1:3) % len
+
+ integer, parameter :: i2 = len (str(1:3))
+ integer, parameter :: j2 = str (1:3) % len
+ integer, parameter :: k2 = (str(1:3) % len)
+ integer, parameter :: lk = str (1:3) % len % kind
+
+ integer, parameter :: l4 = str2 (:) (2:3) % len
+ integer, parameter :: l5 = var % str (:) (2:4) % len
+ integer, parameter :: k4 = str2 (:) (2:3) % kind
+ integer, parameter :: k5 = var % str (:) (2:4) % kind
+ integer, parameter :: k6 = str2 (:) (2:3) % len % kind
+ integer, parameter :: k7 = var % str (:) (2:4) % len % kind
+
+ if (i1 /= 1) stop 1
+ if (j1 /= 1) stop 2
+ if (k1 /= 1) stop 3
+
+ if (i4 /= ck) stop 4
+ if (j4 /= ck) stop 5
+ if (ll /= 3) stop 6
+
+ if (kk /= 4) stop 7
+ if (lk /= 4) stop 8
+
+ if (i2 /= 3) stop 9
+ if (j2 /= 3) stop 10
+ if (k2 /= 3) stop 11
+
+ if (l4 /= 2) stop 12
+ if (l5 /= 3) stop 13
+ if (k4 /= 1) stop 14
+ if (k5 /= 1) stop 15
+ if (k6 /= 4) stop 16
+ if (k7 /= 4) stop 17
+end
+
+! { dg-final { scan-tree-dump-not "_gfortran_stop_numeric" "original" } }
diff --git a/gcc/testsuite/gfortran.dg/inquiry_type_ref_8.f90 b/gcc/testsuite/gfortran.dg/inquiry_type_ref_8.f90
new file mode 100644
index 0000000..70ef621
--- /dev/null
+++ b/gcc/testsuite/gfortran.dg/inquiry_type_ref_8.f90
@@ -0,0 +1,214 @@
+! { dg-do compile }
+! { dg-additional-options "-O0 -fdump-tree-original -std=f2018" }
+!
+! PR fortran/102599 - type parameter inquiries and constant complex arrays
+! PR fortran/114022 - likewise
+!
+! Everything below shall be simplified at compile time.
+
+module mod
+ implicit none
+ public :: wp, c0, z0, y, test1
+ private
+
+ integer :: j
+ integer, parameter :: n = 5
+ integer, parameter :: wp = 8
+ type :: cx
+ real(wp) :: re
+ real(wp) :: im
+ end type cx
+ type(cx), parameter :: c0(*) = [(cx (j,-j), j=1,n)]
+ complex(wp), parameter :: z0(*) = [(cmplx(j,-j,wp),j=1,n)]
+
+ type :: my_type
+ complex(wp) :: z(n) = z0
+ type(cx) :: c(n) = c0
+ end type my_type
+ type(my_type), parameter :: y = my_type()
+
+contains
+
+ ! Check simplification for inquiries of host-associated variables
+ subroutine test1 ()
+ ! Inquiries and full arrays
+ real(wp), parameter :: r0(*) = real (z0)
+ real(wp), parameter :: i0(*) = aimag (z0)
+ real(wp), parameter :: r1(*) = c0 % re
+ real(wp), parameter :: i1(*) = c0 % im
+ real(wp), parameter :: r2(*) = z0 % re
+ real(wp), parameter :: i2(*) = z0 % im
+ real(wp), parameter :: r3(*) = y % c % re
+ real(wp), parameter :: i3(*) = y % c % im
+ real(wp), parameter :: r4(*) = y % z % re
+ real(wp), parameter :: i4(*) = y % z % im
+
+ logical, parameter :: l1 = all (r1 == r0)
+ logical, parameter :: l2 = all (i1 == i0)
+ logical, parameter :: l3 = all (r1 == r2)
+ logical, parameter :: l4 = all (i1 == i2)
+ logical, parameter :: l5 = all (r3 == r4)
+ logical, parameter :: l6 = all (i3 == i4)
+ logical, parameter :: l7 = all (r1 == r3)
+ logical, parameter :: l8 = all (i1 == i3)
+
+ ! Inquiries and array sections
+ real(wp), parameter :: p0(*) = real (z0(::2))
+ real(wp), parameter :: q0(*) = aimag (z0(::2))
+ real(wp), parameter :: p1(*) = c0(::2) % re
+ real(wp), parameter :: q1(*) = c0(::2) % im
+ real(wp), parameter :: p2(*) = z0(::2) % re
+ real(wp), parameter :: q2(*) = z0(::2) % im
+ real(wp), parameter :: p3(*) = y % c(::2) % re
+ real(wp), parameter :: q3(*) = y % c(::2) % im
+ real(wp), parameter :: p4(*) = y % z(::2) % re
+ real(wp), parameter :: q4(*) = y % z(::2) % im
+
+ logical, parameter :: m1 = all (p1 == p0)
+ logical, parameter :: m2 = all (q1 == q0)
+ logical, parameter :: m3 = all (p1 == p2)
+ logical, parameter :: m4 = all (q1 == q2)
+ logical, parameter :: m5 = all (p3 == p4)
+ logical, parameter :: m6 = all (q3 == q4)
+ logical, parameter :: m7 = all (p1 == p3)
+ logical, parameter :: m8 = all (q1 == q3)
+
+ ! Inquiries and vector subscripts
+ real(wp), parameter :: v0(*) = real (z0([3,2]))
+ real(wp), parameter :: w0(*) = aimag (z0([3,2]))
+ real(wp), parameter :: v1(*) = c0([3,2]) % re
+ real(wp), parameter :: w1(*) = c0([3,2]) % im
+ real(wp), parameter :: v2(*) = z0([3,2]) % re
+ real(wp), parameter :: w2(*) = z0([3,2]) % im
+ real(wp), parameter :: v3(*) = y % c([3,2]) % re
+ real(wp), parameter :: w3(*) = y % c([3,2]) % im
+ real(wp), parameter :: v4(*) = y % z([3,2]) % re
+ real(wp), parameter :: w4(*) = y % z([3,2]) % im
+
+ logical, parameter :: o1 = all (v1 == v0)
+ logical, parameter :: o2 = all (w1 == w0)
+ logical, parameter :: o3 = all (v1 == v2)
+ logical, parameter :: o4 = all (w1 == w2)
+ logical, parameter :: o5 = all (v3 == v4)
+ logical, parameter :: o6 = all (w3 == w4)
+ logical, parameter :: o7 = all (v1 == v3)
+ logical, parameter :: o8 = all (w1 == w3)
+
+ ! Miscellaneous
+ complex(wp), parameter :: x(-1:*) = cmplx (r1,i1,kind=wp)
+ real(x%re%kind), parameter :: r(*) = x % re
+ real(x%im%kind), parameter :: i(*) = x % im
+ real(x%re%kind), parameter :: s(*) = [ x(:) % re ]
+ real(x%im%kind), parameter :: t(*) = [ x(:) % im ]
+
+ integer, parameter :: kr = x % re % kind
+ integer, parameter :: ki = x % im % kind
+ integer, parameter :: kx = x % kind
+
+ if (kr /= wp .or. ki /= wp .or. kx /= wp) stop 1
+ if (any (r /= r1)) stop 2
+ if (any (i /= i1)) stop 3
+ if (any (s /= r1)) stop 4
+ if (any (t /= i1)) stop 5
+
+ if (.not. all ([l1,l2,l3,l4,l5,l6,l7,l8])) stop 6
+ if (.not. all ([m1,m2,m3,m4,m5,m6,m7,m8])) stop 7
+ if (.not. all ([o1,o2,o3,o4,o5,o6,o7,o8])) stop 8
+ end subroutine test1
+end
+
+program p
+ use mod, only: wp, c0, z0, y, test1
+ implicit none
+ call test1 ()
+ call test2 ()
+contains
+ ! Check simplification for inquiries of use-associated variables
+ subroutine test2 ()
+ ! Inquiries and full arrays
+ real(wp), parameter :: r0(*) = real (z0)
+ real(wp), parameter :: i0(*) = aimag (z0)
+ real(wp), parameter :: r1(*) = c0 % re
+ real(wp), parameter :: i1(*) = c0 % im
+ real(wp), parameter :: r2(*) = z0 % re
+ real(wp), parameter :: i2(*) = z0 % im
+ real(wp), parameter :: r3(*) = y % c % re
+ real(wp), parameter :: i3(*) = y % c % im
+ real(wp), parameter :: r4(*) = y % z % re
+ real(wp), parameter :: i4(*) = y % z % im
+
+ logical, parameter :: l1 = all (r1 == r0)
+ logical, parameter :: l2 = all (i1 == i0)
+ logical, parameter :: l3 = all (r1 == r2)
+ logical, parameter :: l4 = all (i1 == i2)
+ logical, parameter :: l5 = all (r3 == r4)
+ logical, parameter :: l6 = all (i3 == i4)
+ logical, parameter :: l7 = all (r1 == r3)
+ logical, parameter :: l8 = all (i1 == i3)
+
+ ! Inquiries and array sections
+ real(wp), parameter :: p0(*) = real (z0(::2))
+ real(wp), parameter :: q0(*) = aimag (z0(::2))
+ real(wp), parameter :: p1(*) = c0(::2) % re
+ real(wp), parameter :: q1(*) = c0(::2) % im
+ real(wp), parameter :: p2(*) = z0(::2) % re
+ real(wp), parameter :: q2(*) = z0(::2) % im
+ real(wp), parameter :: p3(*) = y % c(::2) % re
+ real(wp), parameter :: q3(*) = y % c(::2) % im
+ real(wp), parameter :: p4(*) = y % z(::2) % re
+ real(wp), parameter :: q4(*) = y % z(::2) % im
+
+ logical, parameter :: m1 = all (p1 == p0)
+ logical, parameter :: m2 = all (q1 == q0)
+ logical, parameter :: m3 = all (p1 == p2)
+ logical, parameter :: m4 = all (q1 == q2)
+ logical, parameter :: m5 = all (p3 == p4)
+ logical, parameter :: m6 = all (q3 == q4)
+ logical, parameter :: m7 = all (p1 == p3)
+ logical, parameter :: m8 = all (q1 == q3)
+
+ ! Inquiries and vector subscripts
+ real(wp), parameter :: v0(*) = real (z0([3,2]))
+ real(wp), parameter :: w0(*) = aimag (z0([3,2]))
+ real(wp), parameter :: v1(*) = c0([3,2]) % re
+ real(wp), parameter :: w1(*) = c0([3,2]) % im
+ real(wp), parameter :: v2(*) = z0([3,2]) % re
+ real(wp), parameter :: w2(*) = z0([3,2]) % im
+ real(wp), parameter :: v3(*) = y % c([3,2]) % re
+ real(wp), parameter :: w3(*) = y % c([3,2]) % im
+ real(wp), parameter :: v4(*) = y % z([3,2]) % re
+ real(wp), parameter :: w4(*) = y % z([3,2]) % im
+
+ logical, parameter :: o1 = all (v1 == v0)
+ logical, parameter :: o2 = all (w1 == w0)
+ logical, parameter :: o3 = all (v1 == v2)
+ logical, parameter :: o4 = all (w1 == w2)
+ logical, parameter :: o5 = all (v3 == v4)
+ logical, parameter :: o6 = all (w3 == w4)
+ logical, parameter :: o7 = all (v1 == v3)
+ logical, parameter :: o8 = all (w1 == w3)
+
+ ! Miscellaneous
+ complex(wp), parameter :: x(-1:*) = cmplx (r1,i1,kind=wp)
+ real(x%re%kind), parameter :: r(*) = x % re
+ real(x%im%kind), parameter :: i(*) = x % im
+ real(x%re%kind), parameter :: s(*) = [ x(:) % re ]
+ real(x%im%kind), parameter :: t(*) = [ x(:) % im ]
+
+ integer, parameter :: kr = x % re % kind
+ integer, parameter :: ki = x % im % kind
+ integer, parameter :: kx = x % kind
+
+ if (kr /= wp .or. ki /= wp .or. kx /= wp) stop 11
+ if (any (r /= r1)) stop 12
+ if (any (i /= i1)) stop 13
+ if (any (s /= r1)) stop 14
+ if (any (t /= i1)) stop 15
+
+ if (.not. all ([l1,l2,l3,l4,l5,l6,l7,l8])) stop 16
+ if (.not. all ([m1,m2,m3,m4,m5,m6,m7,m8])) stop 17
+ if (.not. all ([o1,o2,o3,o4,o5,o6,o7,o8])) stop 18
+ end subroutine test2
+end
+
+! { dg-final { scan-tree-dump-not "_gfortran_stop_numeric" "original" } }
diff --git a/gcc/testsuite/gfortran.dg/interface_60.f90 b/gcc/testsuite/gfortran.dg/interface_60.f90
new file mode 100644
index 0000000..a7701f6
--- /dev/null
+++ b/gcc/testsuite/gfortran.dg/interface_60.f90
@@ -0,0 +1,70 @@
+! { dg-do run }
+! { dg-options "-Wexternal-argument-mismatch" }
+! Originally proc_ptr_52.f90, this gave an error with the warning above.
+
+module cs
+
+implicit none
+
+integer, target :: integer_target
+
+abstract interface
+ function classStar_map_ifc(x) result(y)
+ class(*), pointer :: y
+ class(*), target, intent(in) :: x
+ end function classStar_map_ifc
+end interface
+
+contains
+
+ function fun(x) result(y)
+ class(*), pointer :: y
+ class(*), target, intent(in) :: x
+ select type (x)
+ type is (integer)
+ integer_target = x ! Deals with dangling target.
+ y => integer_target
+ class default
+ y => null()
+ end select
+ end function fun
+
+ function apply(fap, x) result(y)
+ procedure(classStar_map_ifc) :: fap
+ integer, intent(in) :: x
+ integer :: y
+ class(*), pointer :: p
+ y = 0 ! Get rid of 'y' undefined warning
+ p => fap (x)
+ select type (p)
+ type is (integer)
+ y = p
+ end select
+ end function apply
+
+ function selector() result(fsel)
+ procedure(classStar_map_ifc), pointer :: fsel
+ fsel => fun
+ end function selector
+
+end module cs
+
+
+program classStar_map
+
+use cs
+implicit none
+
+integer :: x, y
+procedure(classStar_map_ifc), pointer :: fm
+
+x = 123654
+fm => selector () ! Fixed by second chunk in patch
+y = apply (fm, x) ! Fixed by first chunk in patch
+if (x .ne. y) stop 1
+
+x = 2 * x
+y = apply (fun, x) ! PR93925; fixed as above
+if (x .ne. y) stop 2
+
+end program classStar_map
diff --git a/gcc/testsuite/gfortran.dg/interface_61.f90 b/gcc/testsuite/gfortran.dg/interface_61.f90
new file mode 100644
index 0000000..15db3b8a
--- /dev/null
+++ b/gcc/testsuite/gfortran.dg/interface_61.f90
@@ -0,0 +1,27 @@
+! { dg-do compile }
+! { dg-options -Wexternal-argument-mismatch }
+! PR fortran/120163 - this used to cause an error.
+! Original test case by Bálint Aradi
+module mod1
+ implicit none
+
+ abstract interface
+ pure subroutine callback_interface(a)
+ real, intent(in) :: a
+ end subroutine callback_interface
+ end interface
+
+contains
+
+ subroutine caller(callback)
+ procedure(callback_interface) :: callback
+ real :: a
+ call callback(a)
+ end subroutine caller
+
+end module mod1
+
+
+module mod2
+ use mod1
+end module mod2
diff --git a/gcc/testsuite/gfortran.dg/interface_62.f90 b/gcc/testsuite/gfortran.dg/interface_62.f90
new file mode 100644
index 0000000..19d4325
--- /dev/null
+++ b/gcc/testsuite/gfortran.dg/interface_62.f90
@@ -0,0 +1,39 @@
+! { dg-do compile }
+! PR fortran/120355 - this was rejected because the typespec from
+! the RESULT clause was not picked up.
+! Test case jsberg@bnl.gov.
+
+program p
+ implicit none
+ integer :: i,j
+ interface
+ function s(x) result(y)
+ implicit none
+ integer, intent(in) :: x
+ integer :: y
+ end function s
+ end interface
+ i = 0
+ call t(s,i,j)
+contains
+ subroutine t(f,x,y)
+ implicit none
+ integer, intent(in) :: x
+ integer, intent(out) :: y
+ interface
+ function f(x) result(y)
+ implicit none
+ integer, intent(in) :: x
+ integer :: y
+ end function f
+ end interface
+ y = f(x)
+ end subroutine t
+end program p
+
+function s(x) result(y)
+ implicit none
+ integer, intent(in) :: x
+ integer :: y
+ y = 1 - x
+end function s
diff --git a/gcc/testsuite/gfortran.dg/interface_63.f90 b/gcc/testsuite/gfortran.dg/interface_63.f90
new file mode 100644
index 0000000..56c1644
--- /dev/null
+++ b/gcc/testsuite/gfortran.dg/interface_63.f90
@@ -0,0 +1,97 @@
+! { dg-do compile }
+! PR fortran/120784 - fix checking of renamed-on-use interface name
+!
+! Contributed by Matt Thompson <matthew.thompson at nasa dot gov>
+
+module A_mod
+ implicit none
+
+ interface Get
+ procedure :: get_1
+ procedure :: get_2
+ end interface Get
+
+contains
+
+ subroutine get_1(i)
+ integer :: i
+ i = 5
+ end subroutine get_1
+
+ subroutine get_2(x)
+ real :: x
+ x = 4
+ end subroutine get_2
+end module A_mod
+
+module B_mod
+ use A_mod, only : MyGet => Get
+ implicit none
+
+ interface MyGet
+ procedure :: other_get
+ end interface MyGet
+
+contains
+
+ subroutine other_get(c)
+ character(1) :: c
+ c = 'a'
+ end subroutine other_get
+
+ subroutine check_get ()
+ character :: c
+ integer :: i
+ real :: r
+ call myget (c)
+ call myget (i)
+ call myget (r)
+ end subroutine check_get
+
+end module B_MOD
+
+program p
+ use b_mod, only: myget
+ implicit none
+ character :: c
+ integer :: i
+ real :: r
+ call myget (c)
+ call myget (i)
+ call myget (r)
+end
+
+! Check that we do not regress on the following:
+
+module mod1
+ implicit none
+
+ interface local
+ module procedure local_data
+ end interface local
+
+contains
+
+ logical function local_data (data) result (local)
+ real, intent(in) :: data
+ local = .true.
+ end function local_data
+
+end module mod1
+
+module mod2
+ use mod1, only: local
+ implicit none
+
+ interface local
+ module procedure local_invt
+ end interface local
+
+contains
+
+ logical function local_invt (invt) result (local)
+ integer, intent(in) :: invt
+ local = .true.
+ end function local_invt
+
+end module mod2
diff --git a/gcc/testsuite/gfortran.dg/move_alloc_20.f03 b/gcc/testsuite/gfortran.dg/move_alloc_20.f03
new file mode 100644
index 0000000..20403c3
--- /dev/null
+++ b/gcc/testsuite/gfortran.dg/move_alloc_20.f03
@@ -0,0 +1,151 @@
+! { dg-do run }
+!
+! Check the presence of the pre and post code of the FROM and TO arguments
+! of the MOVE_ALLOC intrinsic subroutine.
+
+module m
+ implicit none
+ type :: t
+ integer, allocatable :: a(:)
+ end type
+end module
+
+module pre
+ use m
+ implicit none
+ private
+ public :: check_pre
+
+contains
+
+ subroutine check_pre
+ integer, parameter :: n = 5
+ type(t) :: x(n)
+ integer, allocatable :: tmp(:)
+ integer :: array(4) = [ -1, 0, 1, 2 ]
+ integer :: i
+
+ if (allocated(tmp)) error stop 1
+
+ tmp = [17]
+
+ if (.not. allocated(tmp)) error stop 11
+ if (any(shape(tmp) /= [1])) error stop 12
+ if (any(tmp /= [17])) error stop 13
+ do i=1,n
+ if (allocated(x(i)%a)) error stop 14
+ end do
+
+ ! Check that the index of X is properly computed for the evaluation of TO.
+ call move_alloc(tmp, x(sum(array))%a)
+
+ do i=1,n
+ if (i == 2) cycle
+ if (allocated(x(i)%a)) error stop 21
+ end do
+ if (.not. allocated(x(2)%a)) error stop 22
+ if (any(shape(x(2)%a) /= [1])) error stop 23
+ if (any(x(2)%a /= [17])) error stop 24
+ if (allocated(tmp)) error stop 25
+
+ ! Check that the index of X is properly computed for the evaluation of FROM.
+ call move_alloc(x(sum(array))%a, tmp)
+
+ if (.not. allocated(tmp)) error stop 31
+ if (any(shape(tmp) /= [1])) error stop 32
+ if (any(tmp /= [17])) error stop 33
+ do i=1,n
+ if (allocated(x(i)%a)) error stop 34
+ end do
+ end subroutine
+
+end module
+
+module post
+ use m
+ implicit none
+ private
+ public :: check_post
+ integer, parameter :: n = 5
+ type(t), target :: x(n)
+ type :: u
+ integer :: a
+ contains
+ final :: finalize
+ end type
+ integer :: finalization_count = 0
+
+contains
+
+ function idx(arg)
+ type(u) :: arg
+ integer :: idx
+ idx = mod(arg%a, n)
+ end function
+
+ subroutine check_post
+ type(u) :: y
+ integer, allocatable :: tmp(:)
+ integer, target :: array(4) = [ -1, 0, 1, 2 ]
+ integer :: i
+
+ y%a = 12
+
+ if (allocated(tmp)) error stop 1
+
+ tmp = [37]
+
+ if (.not. allocated(tmp)) error stop 11
+ if (any(shape(tmp) /= [1])) error stop 12
+ if (any(tmp /= [37])) error stop 13
+ if (finalization_count /= 0) error stop 14
+ do i=1,n
+ if (allocated(x(i)%a)) error stop 15
+ end do
+
+ ! Check that the cleanup code for the evaluation of TO is properly
+ ! executed after MOVE_ALLOC: the result of GET_U should be finalized.
+ call move_alloc(tmp, x(idx(get_u(y)))%a)
+
+ do i=1,n
+ if (i == 2) cycle
+ if (allocated(x(i)%a)) error stop 21
+ end do
+ if (.not. allocated(x(2)%a)) error stop 22
+ if (any(shape(x(2)%a) /= [1])) error stop 23
+ if (any(x(2)%a /= [37])) error stop 24
+ if (allocated(tmp)) error stop 25
+ if (finalization_count /= 1) error stop 26
+
+ ! Check that the cleanup code for the evaluation of FROM is properly
+ ! executed after MOVE_ALLOC: the result of GET_U should be finalized.
+ call move_alloc(x(idx(get_u(y)))%a, tmp)
+
+ if (.not. allocated(tmp)) error stop 31
+ if (any(shape(tmp) /= [1])) error stop 32
+ if (any(tmp /= [37])) error stop 33
+ if (finalization_count /= 2) error stop 34
+ do i=1,n
+ if (allocated(x(i)%a)) error stop 35
+ end do
+ end subroutine
+
+ function get_u(arg)
+ type(u) :: arg, get_u
+ get_u = arg
+ end function get_u
+
+ subroutine finalize(obj)
+ type(u) :: obj
+ finalization_count = finalization_count + 1
+ end subroutine
+
+end module
+
+program p
+ use pre
+ use post
+ implicit none
+ call check_pre
+ call check_post
+end program
diff --git a/gcc/testsuite/gfortran.dg/non_lvalue_1.f90 b/gcc/testsuite/gfortran.dg/non_lvalue_1.f90
new file mode 100644
index 0000000..61dad5a
--- /dev/null
+++ b/gcc/testsuite/gfortran.dg/non_lvalue_1.f90
@@ -0,0 +1,32 @@
+! { dg-do compile }
+! { dg-additional-options "-fdump-tree-original" }
+!
+! Check the generation of NON_LVALUE_EXPR expressions in cases where a unary
+! operator expression would simplify to a bare data reference.
+
+! A NON_LVALUE_EXPR is generated for a double negation that would simplify to
+! a bare data reference.
+function f1 (f1_arg1)
+ integer, value :: f1_arg1
+ integer :: f1
+ f1 = -(-f1_arg1)
+end function
+! { dg-final { scan-tree-dump "__result_f1 = NON_LVALUE_EXPR <f1_arg1>;" "original" } }
+
+! A NON_LVALUE_EXPR is generated for a double complement that would simplify to
+! a bare data reference.
+function f2 (f2_arg1)
+ integer, value :: f2_arg1
+ integer :: f2
+ f2 = not(not(f2_arg1))
+end function
+! { dg-final { scan-tree-dump "__result_f2 = NON_LVALUE_EXPR <f2_arg1>;" "original" } }
+
+! A NON_LVALUE_EXPR is generated for a double complex conjugate that would
+! simplify to a bare data reference.
+function f3 (f3_arg1)
+ complex, value :: f3_arg1
+ complex :: f3
+ f3 = conjg(conjg(f3_arg1))
+end function
+! { dg-final { scan-tree-dump "__result_f3 = NON_LVALUE_EXPR <f3_arg1>;" "original" } }
diff --git a/gcc/testsuite/gfortran.dg/pr119856.f90 b/gcc/testsuite/gfortran.dg/pr119856.f90
new file mode 100644
index 0000000..60ada0a
--- /dev/null
+++ b/gcc/testsuite/gfortran.dg/pr119856.f90
@@ -0,0 +1,15 @@
+! { dg-do run }
+! PR119856, the error should occur in both write statements.
+program badfmt
+ implicit none
+
+ character(10):: fmt = "(AI5)" ! Not a PARAMETER so not examined
+ ! at compile time
+ integer :: ioerr
+ ioerr = 0
+ write (*, fmt, iostat=ioerr) 'value =', 42
+ if (ioerr /= 5006) stop 10
+!
+ write (*, fmt, iostat=ioerr) 'value =', 43
+ if (ioerr /= 5006) stop 13
+end program badfmt
diff --git a/gcc/testsuite/gfortran.dg/pr119948.f90 b/gcc/testsuite/gfortran.dg/pr119948.f90
index 9ecb080..2e36fae 100644
--- a/gcc/testsuite/gfortran.dg/pr119948.f90
+++ b/gcc/testsuite/gfortran.dg/pr119948.f90
@@ -1,7 +1,8 @@
-! { dg-do compile }
+! { dg-do run }
!
-! Test the fix for PR119948, which used to fail as indicated below with,
-! "Error: Bad allocate-object at (1) for a PURE procedure"
+! Test the fix for PR119948, which used to fail as indicated below with:
+! (1) "Error: Bad allocate-object at (1) for a PURE procedure"
+! (2) "Error: ‘construct_test2 at (1) is not a variable"
!
! Contributed by Damian Rouson <damian@archaeologic.codes>
!
@@ -18,33 +19,65 @@ module test_m
type(test_t) :: test
type(test_t), intent(in) :: arg
end function
- pure module function construct_test_sub(arg) result(test)
+
+ pure module function construct_test2(arg)
+ implicit none
+ type(test_t) construct_test2
+ type(test_t), intent(in) :: arg
+ end function
+
+ pure module function construct_test_3(arg) result(test)
implicit none
type(test_t) :: test
type(test_t), intent(in) :: arg
end function
+
+ pure module function construct_test_4(arg)
+ implicit none
+ type(test_t) :: construct_test_4
+ type(test_t), intent(in) :: arg
+ end function
end interface
contains
module procedure construct_test
- allocate(test%i, source = arg%i) ! Used to fail here
+ allocate(test%i, source = arg%i) ! Fail #1
+ end procedure
+
+ module procedure construct_test2
+ allocate(construct_test2%i, source = arg%i) ! Fail #2
end procedure
end module
submodule (test_m)test_s
contains
- module procedure construct_test_sub
+ module procedure construct_test_3
allocate(test%i, source = arg%i) ! This was OK.
end procedure
+
+ module procedure construct_test_4
+ allocate(construct_test_4%i, source = arg%i) ! This was OK.
+ end procedure
end submodule
use test_m
type(test_t) :: res, dummy
- dummy%i = 42
+!
+ dummy%i = int (rand () * 1e6)
res = construct_test (dummy)
if (res%i /= dummy%i) stop 1
- dummy%i = -42
- res = construct_test_sub (dummy)
+!
+ dummy%i = int (rand () * 1e6)
+ res = construct_test2 (dummy)
if (res%i /= dummy%i) stop 2
+!
+ dummy%i = int (rand () * 1e6)
+ res = construct_test_3 (dummy)
+ if (res%i /= dummy%i) stop 3
+
+ dummy%i = int (rand () * 1e6)
+ res = construct_test_4 (dummy)
+ if (res%i /= dummy%i) stop 4
+
deallocate (res%i, dummy%i)
end
diff --git a/gcc/testsuite/gfortran.dg/pr120049_2.f90 b/gcc/testsuite/gfortran.dg/pr120049_2.f90
new file mode 100644
index 0000000..1f91e06
--- /dev/null
+++ b/gcc/testsuite/gfortran.dg/pr120049_2.f90
@@ -0,0 +1,62 @@
+! Compiled with pr120049_b.f90
+! { dg-options -O0 }
+! { dg-do compile }
+! { dg-compile-aux-modules "pr120049_b.f90" }
+!
+! Test the fix for PR120049
+program tests_gtk_sup
+ use gtk_sup
+ implicit none
+
+ type mytype
+ integer :: myint
+ end type mytype
+ type(mytype) :: ijkl = mytype(42)
+ logical :: truth
+ real :: var1
+ type(c_ptr), target :: val
+ type(c_funptr), target :: fptr
+ character(15) :: stringy
+ complex :: certainly
+ truth = .true.
+ var1 = 86.
+ stringy = "what the hay!"
+ certainly = (3.14,-4.13)
+ if (c_associated(val, c_loc(val))) then
+ stop 1
+ endif
+ if (c_associated(c_loc(val), val)) then
+ stop 2
+ endif
+ print *, c_associated(fptr, C_NULL_FUNPTR)
+ print *, c_associated(c_loc(val), C_NULL_PTR)
+ print *, c_associated(C_NULL_PTR, c_loc(val))
+ print *, c_associated(c_loc(val), 42) ! { dg-error "C_ASSOCIATED shall have the" }
+ print *, c_associated(c_loc(val), .42) ! { dg-error "C_ASSOCIATED shall have the" }
+ print *, c_associated(c_loc(val), truth) ! { dg-error "C_ASSOCIATED shall have the" }
+ print *, c_associated(c_loc(val), .false.) ! { dg-error "C_ASSOCIATED shall have the" }
+ print *, c_associated(c_loc(val), var1) ! { dg-error "C_ASSOCIATED shall have the" }
+ print *, c_associated(c_loc(val), stringy) ! { dg-error "C_ASSOCIATED shall have the" }
+ print *, c_associated(c_loc(val), certainly) ! { dg-error "C_ASSOCIATED shall have the" }
+ print *, c_associated(42) ! { dg-error "C_ASSOCIATED shall have the" }
+ print *, c_associated(.42) ! { dg-error "C_ASSOCIATED shall have the" }
+ print *, c_associated(truth) ! { dg-error "C_ASSOCIATED shall have the" }
+ print *, c_associated(.false.) ! { dg-error "C_ASSOCIATED shall have the" }
+ print *, c_associated(var1) ! { dg-error "C_ASSOCIATED shall have the" }
+ print *, c_associated(stringy) ! { dg-error "C_ASSOCIATED shall have the" }
+ print *, c_associated(certainly) ! { dg-error "C_ASSOCIATED shall have the" }
+ print *, c_associated(.42) ! { dg-error "C_ASSOCIATED shall have the" }
+ print *, c_associated(val, testit(val)) ! { dg-error "C_ASSOCIATED shall have the" }
+ print *, c_associated(testit(val), val) ! { dg-error "C_ASSOCIATED shall have the" }
+ print *, c_associated(testit(val)) ! { dg-error "C_ASSOCIATED shall have the" }
+ print *, c_associated(c_loc(val), C_NULL_FUNPTR) ! { dg-error "C_ASSOCIATED shall have the" }
+ print *, c_associated(C_NULL_FUNPTR, c_loc(val)) ! { dg-error "C_ASSOCIATED shall have the" }
+contains
+
+ function testit (avalue) result(res)
+ type(c_ptr) :: avalue
+ type(mytype) :: res
+ res%myint = 42
+ end function
+
+end program tests_gtk_sup
diff --git a/gcc/testsuite/gfortran.dg/pr120049_a.f90 b/gcc/testsuite/gfortran.dg/pr120049_a.f90
new file mode 100644
index 0000000..7095314
--- /dev/null
+++ b/gcc/testsuite/gfortran.dg/pr120049_a.f90
@@ -0,0 +1,18 @@
+! Compiled with pr120049_b.f90
+! { dg-options -O0 }
+! { dg-do run }
+! { dg-compile-aux-modules "pr120049_b.f90" }
+! { dg-additional-sources pr120049_b.f90 }
+!
+! Test the fix for PR86248
+program tests_gtk_sup
+ use gtk_sup
+ implicit none
+ type(c_ptr), target :: val
+ if (c_associated(val, c_loc(val))) then
+ stop 1
+ endif
+ if (c_associated(c_loc(val), val)) then
+ stop 2
+ endif
+end program tests_gtk_sup
diff --git a/gcc/testsuite/gfortran.dg/pr120049_b.f90 b/gcc/testsuite/gfortran.dg/pr120049_b.f90
new file mode 100644
index 0000000..28a2783
--- /dev/null
+++ b/gcc/testsuite/gfortran.dg/pr120049_b.f90
@@ -0,0 +1,6 @@
+!
+! Module for pr120049.f90
+!
+module gtk_sup
+ use, intrinsic :: iso_c_binding
+end module gtk_sup
diff --git a/gcc/testsuite/gfortran.dg/pr120152_1.f90 b/gcc/testsuite/gfortran.dg/pr120152_1.f90
new file mode 100644
index 0000000..c49197d
--- /dev/null
+++ b/gcc/testsuite/gfortran.dg/pr120152_1.f90
@@ -0,0 +1,52 @@
+! PR libfortran/120152
+! { dg-do run }
+
+subroutine f1
+ integer(kind=8) :: a (10, 10, 10), b (10, 10)
+ logical :: c (10, 10, 10)
+ a = 0
+ c = .true.
+ b = maxloc (a, 2, c, 8, .true.)
+end
+subroutine f2
+ integer(kind=8) :: a (10, 10, 10)
+ integer(kind=4) :: b (10, 10)
+ logical :: c (10, 10, 10)
+ a = 0
+ c = .true.
+ b = maxloc (a, 2, c, 4, .true.)
+end
+subroutine f3
+ integer(kind=8) :: a (10, 10, 10), b (10, 10)
+ a = 0
+ b = maxloc (a, 2, kind=8, back=.true.)
+end
+subroutine f4
+ integer(kind=8) :: a (10, 10, 10)
+ integer(kind=4) :: b (10, 10)
+ a = 0
+ b = maxloc (a, 2, kind=4, back=.true.)
+end
+subroutine f5
+ integer(kind=8) :: a (10, 10, 10), b (10, 10)
+ logical :: c
+ a = 0
+ c = .false.
+ b = maxloc (a, 2, c, 8, .true.)
+end
+subroutine f6
+ integer(kind=8) :: a (10, 10, 10)
+ integer(kind=4) :: b (10, 10)
+ logical :: c
+ a = 0
+ c = .false.
+ b = maxloc (a, 2, c, 4, .true.)
+end
+program pr120152
+ call f1
+ call f2
+ call f3
+ call f4
+ call f5
+ call f6
+end
diff --git a/gcc/testsuite/gfortran.dg/pr120152_2.f90 b/gcc/testsuite/gfortran.dg/pr120152_2.f90
new file mode 100644
index 0000000..39cfb28
--- /dev/null
+++ b/gcc/testsuite/gfortran.dg/pr120152_2.f90
@@ -0,0 +1,80 @@
+! PR libfortran/120152
+! { dg-do run { target fortran_large_int } }
+
+subroutine f1
+ integer(kind=16) :: a (10, 10, 10)
+ integer(kind=8) :: b (10, 10)
+ logical :: c (10, 10, 10)
+ a = 0
+ c = .true.
+ b = maxloc (a, 2, c, 8, .true.)
+end
+subroutine f2
+ integer(kind=16) :: a (10, 10, 10)
+ integer(kind=4) :: b (10, 10)
+ logical :: c (10, 10, 10)
+ a = 0
+ c = .true.
+ b = maxloc (a, 2, c, 4, .true.)
+end
+subroutine f3
+ integer(kind=16) :: a (10, 10, 10)
+ integer(kind=8) :: b (10, 10)
+ a = 0
+ b = maxloc (a, 2, kind=8, back=.true.)
+end
+subroutine f4
+ integer(kind=16) :: a (10, 10, 10)
+ integer(kind=4) :: b (10, 10)
+ a = 0
+ b = maxloc (a, 2, kind=4, back=.true.)
+end
+subroutine f5
+ integer(kind=16) :: a (10, 10, 10)
+ integer(kind=8) :: b (10, 10)
+ logical :: c
+ a = 0
+ c = .false.
+ b = maxloc (a, 2, c, 8, .true.)
+end
+subroutine f6
+ integer(kind=16) :: a (10, 10, 10)
+ integer(kind=4) :: b (10, 10)
+ logical :: c
+ a = 0
+ c = .false.
+ b = maxloc (a, 2, c, 4, .true.)
+end
+subroutine f7
+ integer(kind=8) :: a (10, 10, 10)
+ integer(kind=16) :: b (10, 10)
+ logical :: c (10, 10, 10)
+ a = 0
+ c = .true.
+ b = maxloc (a, 2, c, 16, .true.)
+end
+subroutine f8
+ integer(kind=8) :: a (10, 10, 10)
+ integer(kind=16) :: b (10, 10)
+ a = 0
+ b = maxloc (a, 2, kind=16, back=.true.)
+end
+subroutine f9
+ integer(kind=8) :: a (10, 10, 10)
+ integer(kind=16) :: b (10, 10)
+ logical :: c
+ a = 0
+ c = .false.
+ b = maxloc (a, 2, c, 16, .true.)
+end
+program pr120152
+ call f1
+ call f2
+ call f3
+ call f4
+ call f5
+ call f6
+ call f7
+ call f8
+ call f9
+end
diff --git a/gcc/testsuite/gfortran.dg/pr120153.f90 b/gcc/testsuite/gfortran.dg/pr120153.f90
new file mode 100644
index 0000000..22a7849
--- /dev/null
+++ b/gcc/testsuite/gfortran.dg/pr120153.f90
@@ -0,0 +1,36 @@
+! PR libfortran/120153
+! { dg-do run { target fortran_large_int } }
+! { dg-additional-options "-funsigned" }
+
+subroutine f1
+ unsigned(kind=16) :: a (10, 10, 10)
+ integer(kind=16) :: b (10, 10)
+ logical :: c (10, 10, 10)
+ a = 0u_16
+ c = .true.
+ b = maxloc (a, 2, c, 16, .true.)
+end
+subroutine f2
+ unsigned(kind=16) :: a (10, 10, 10)
+ integer(kind=16) :: b (10, 10)
+ a = 0u_16
+ b = maxloc (a, 2, kind=16, back=.true.)
+end
+subroutine f3
+ unsigned(kind=16) :: a (10, 10, 10)
+ integer(kind=8) :: b (10, 10)
+ logical :: c
+ a = 0u_16
+ c = .false.
+ b = maxloc (a, 2, c, 16, .true.)
+end
+subroutine f4
+ unsigned(kind=16) :: a (5, 5, 5)
+ call random_number (a)
+end
+program pr120153
+ call f1
+ call f2
+ call f3
+ call f4
+end
diff --git a/gcc/testsuite/gfortran.dg/pr120158.f90 b/gcc/testsuite/gfortran.dg/pr120158.f90
new file mode 100644
index 0000000..593f4bc
--- /dev/null
+++ b/gcc/testsuite/gfortran.dg/pr120158.f90
@@ -0,0 +1,15 @@
+! PR libfortran/120158
+! { dg-do run { target fortran_large_int } }
+! { dg-additional-options "-funsigned" }
+
+ unsigned(kind=8) :: a(10, 10, 10), b(10, 10)
+ integer(kind=8) :: c(10, 10), d(10, 10)
+ a = 0u_8
+ if (maxval (a) .ne. 0u_8) stop 1
+ b = maxval (a, 1)
+ if (any (b .ne. 0u_8)) stop 2
+ c = maxloc (a, 1)
+ d = maxloc (a, 2, back=.true.)
+ if (any (c .ne. 1)) stop 3
+ if (any (d .ne. 10)) stop 4
+end
diff --git a/gcc/testsuite/gfortran.dg/pr120191_1.f90 b/gcc/testsuite/gfortran.dg/pr120191_1.f90
new file mode 100644
index 0000000..13a787d
--- /dev/null
+++ b/gcc/testsuite/gfortran.dg/pr120191_1.f90
@@ -0,0 +1,614 @@
+! PR fortran/120191
+! { dg-do run }
+
+ integer(kind=1) :: a1(10, 10, 10), b1(10)
+ integer(kind=2) :: a2(10, 10, 10), b2(10)
+ integer(kind=4) :: a4(10, 10, 10), b4(10)
+ integer(kind=8) :: a8(10, 10, 10), b8(10)
+ real(kind=4) :: r4(10, 10, 10), s4(10)
+ real(kind=8) :: r8(10, 10, 10), s8(10)
+ logical :: l1(10, 10, 10), l2(10), l3
+ l1 = .true.
+ l2 = .true.
+ l3 = .true.
+ a1 = 0
+ if (any (maxloc (a1) .ne. 1)) stop 1
+ if (any (maxloc (a1, back=.false.) .ne. 1)) stop 2
+ if (any (maxloc (a1, back=.true.) .ne. 10)) stop 3
+ if (any (maxloc (a1, kind=2) .ne. 1)) stop 4
+ if (any (maxloc (a1, kind=4, back=.false.) .ne. 1)) stop 5
+ if (any (maxloc (a1, kind=8, back=.true.) .ne. 10)) stop 6
+ if (any (maxloc (a1, 1) .ne. 1)) stop 7
+ if (any (maxloc (a1, 1, back=.false.) .ne. 1)) stop 8
+ if (any (maxloc (a1, 1, back=.true.) .ne. 10)) stop 9
+ if (any (maxloc (a1, 1, kind=1) .ne. 1)) stop 10
+ if (any (maxloc (a1, 1, kind=2, back=.false.) .ne. 1)) stop 11
+ if (any (maxloc (a1, 1, kind=4, back=.true.) .ne. 10)) stop 12
+ if (any (maxloc (a1, 1, l1) .ne. 1)) stop 13
+ if (any (maxloc (a1, 1, l1, back=.false.) .ne. 1)) stop 14
+ if (any (maxloc (a1, 1, l1, back=.true.) .ne. 10)) stop 15
+ if (any (maxloc (a1, 1, l1, kind=8) .ne. 1)) stop 16
+ if (any (maxloc (a1, 1, l1, 4, .false.) .ne. 1)) stop 17
+ if (any (maxloc (a1, 1, l1, 2, .true.) .ne. 10)) stop 18
+ if (any (maxloc (a1, 1, l3) .ne. 1)) stop 19
+ if (any (maxloc (a1, 1, l3, back=.false.) .ne. 1)) stop 20
+ if (any (maxloc (a1, 1, l3, back=.true.) .ne. 10)) stop 21
+ if (any (maxloc (a1, 1, l3, kind=8) .ne. 1)) stop 22
+ if (any (maxloc (a1, 1, l3, 4, .false.) .ne. 1)) stop 23
+ if (any (maxloc (a1, 1, l3, 2, .true.) .ne. 10)) stop 24
+ b1 = 0
+ if (any (maxloc (b1) .ne. 1)) stop 1
+ if (any (maxloc (b1, back=.false.) .ne. 1)) stop 2
+ if (any (maxloc (b1, back=.true.) .ne. 10)) stop 3
+ if (any (maxloc (b1, kind=2) .ne. 1)) stop 4
+ if (any (maxloc (b1, kind=4, back=.false.) .ne. 1)) stop 5
+ if (any (maxloc (b1, kind=8, back=.true.) .ne. 10)) stop 6
+ if (maxloc (b1, 1) .ne. 1) stop 7
+ if (maxloc (b1, 1, back=.false.) .ne. 1) stop 8
+ if (maxloc (b1, 1, back=.true.) .ne. 10) stop 9
+ if (maxloc (b1, 1, kind=1) .ne. 1) stop 10
+ if (maxloc (b1, 1, kind=2, back=.false.) .ne. 1) stop 11
+ if (maxloc (b1, 1, kind=4, back=.true.) .ne. 10) stop 12
+ if (maxloc (b1, 1, l2) .ne. 1) stop 13
+ if (maxloc (b1, 1, l2, back=.false.) .ne. 1) stop 14
+ if (maxloc (b1, 1, l2, back=.true.) .ne. 10) stop 15
+ if (maxloc (b1, 1, l2, kind=8) .ne. 1) stop 16
+ if (maxloc (b1, 1, l2, 4, .false.) .ne. 1) stop 17
+ if (maxloc (b1, 1, l2, 2, .true.) .ne. 10) stop 18
+ if (maxloc (b1, 1, l3) .ne. 1) stop 19
+ if (maxloc (b1, 1, l3, back=.false.) .ne. 1) stop 20
+ if (maxloc (b1, 1, l3, back=.true.) .ne. 10) stop 21
+ if (maxloc (b1, 1, l3, kind=8) .ne. 1) stop 22
+ if (maxloc (b1, 1, l3, 4, .false.) .ne. 1) stop 23
+ if (maxloc (b1, 1, l3, 2, .true.) .ne. 10) stop 24
+ a2 = 0
+ if (any (maxloc (a2) .ne. 1)) stop 1
+ if (any (maxloc (a2, back=.false.) .ne. 1)) stop 2
+ if (any (maxloc (a2, back=.true.) .ne. 10)) stop 3
+ if (any (maxloc (a2, kind=2) .ne. 1)) stop 4
+ if (any (maxloc (a2, kind=4, back=.false.) .ne. 1)) stop 5
+ if (any (maxloc (a2, kind=8, back=.true.) .ne. 10)) stop 6
+ if (any (maxloc (a2, 1) .ne. 1)) stop 7
+ if (any (maxloc (a2, 1, back=.false.) .ne. 1)) stop 8
+ if (any (maxloc (a2, 1, back=.true.) .ne. 10)) stop 9
+ if (any (maxloc (a2, 1, kind=1) .ne. 1)) stop 10
+ if (any (maxloc (a2, 1, kind=2, back=.false.) .ne. 1)) stop 11
+ if (any (maxloc (a2, 1, kind=4, back=.true.) .ne. 10)) stop 12
+ if (any (maxloc (a2, 1, l1) .ne. 1)) stop 13
+ if (any (maxloc (a2, 1, l1, back=.false.) .ne. 1)) stop 14
+ if (any (maxloc (a2, 1, l1, back=.true.) .ne. 10)) stop 15
+ if (any (maxloc (a2, 1, l1, kind=8) .ne. 1)) stop 16
+ if (any (maxloc (a2, 1, l1, 4, .false.) .ne. 1)) stop 17
+ if (any (maxloc (a2, 1, l1, 2, .true.) .ne. 10)) stop 18
+ if (any (maxloc (a2, 1, l3) .ne. 1)) stop 19
+ if (any (maxloc (a2, 1, l3, back=.false.) .ne. 1)) stop 20
+ if (any (maxloc (a2, 1, l3, back=.true.) .ne. 10)) stop 21
+ if (any (maxloc (a2, 1, l3, kind=8) .ne. 1)) stop 22
+ if (any (maxloc (a2, 1, l3, 4, .false.) .ne. 1)) stop 23
+ if (any (maxloc (a2, 1, l3, 2, .true.) .ne. 10)) stop 24
+ b2 = 0
+ if (any (maxloc (b2) .ne. 1)) stop 1
+ if (any (maxloc (b2, back=.false.) .ne. 1)) stop 2
+ if (any (maxloc (b2, back=.true.) .ne. 10)) stop 3
+ if (any (maxloc (b2, kind=2) .ne. 1)) stop 4
+ if (any (maxloc (b2, kind=4, back=.false.) .ne. 1)) stop 5
+ if (any (maxloc (b2, kind=8, back=.true.) .ne. 10)) stop 6
+ if (maxloc (b2, 1) .ne. 1) stop 7
+ if (maxloc (b2, 1, back=.false.) .ne. 1) stop 8
+ if (maxloc (b2, 1, back=.true.) .ne. 10) stop 9
+ if (maxloc (b2, 1, kind=1) .ne. 1) stop 10
+ if (maxloc (b2, 1, kind=2, back=.false.) .ne. 1) stop 11
+ if (maxloc (b2, 1, kind=4, back=.true.) .ne. 10) stop 12
+ if (maxloc (b2, 1, l2) .ne. 1) stop 13
+ if (maxloc (b2, 1, l2, back=.false.) .ne. 1) stop 14
+ if (maxloc (b2, 1, l2, back=.true.) .ne. 10) stop 15
+ if (maxloc (b2, 1, l2, kind=8) .ne. 1) stop 16
+ if (maxloc (b2, 1, l2, 4, .false.) .ne. 1) stop 17
+ if (maxloc (b2, 1, l2, 2, .true.) .ne. 10) stop 18
+ if (maxloc (b2, 1, l3) .ne. 1) stop 19
+ if (maxloc (b2, 1, l3, back=.false.) .ne. 1) stop 20
+ if (maxloc (b2, 1, l3, back=.true.) .ne. 10) stop 21
+ if (maxloc (b2, 1, l3, kind=8) .ne. 1) stop 22
+ if (maxloc (b2, 1, l3, 4, .false.) .ne. 1) stop 23
+ if (maxloc (b2, 1, l3, 2, .true.) .ne. 10) stop 24
+ a4 = 0
+ if (any (maxloc (a4) .ne. 1)) stop 1
+ if (any (maxloc (a4, back=.false.) .ne. 1)) stop 2
+ if (any (maxloc (a4, back=.true.) .ne. 10)) stop 3
+ if (any (maxloc (a4, kind=2) .ne. 1)) stop 4
+ if (any (maxloc (a4, kind=4, back=.false.) .ne. 1)) stop 5
+ if (any (maxloc (a4, kind=8, back=.true.) .ne. 10)) stop 6
+ if (any (maxloc (a4, 1) .ne. 1)) stop 7
+ if (any (maxloc (a4, 1, back=.false.) .ne. 1)) stop 8
+ if (any (maxloc (a4, 1, back=.true.) .ne. 10)) stop 9
+ if (any (maxloc (a4, 1, kind=1) .ne. 1)) stop 10
+ if (any (maxloc (a4, 1, kind=2, back=.false.) .ne. 1)) stop 11
+ if (any (maxloc (a4, 1, kind=4, back=.true.) .ne. 10)) stop 12
+ if (any (maxloc (a4, 1, l1) .ne. 1)) stop 13
+ if (any (maxloc (a4, 1, l1, back=.false.) .ne. 1)) stop 14
+ if (any (maxloc (a4, 1, l1, back=.true.) .ne. 10)) stop 15
+ if (any (maxloc (a4, 1, l1, kind=8) .ne. 1)) stop 16
+ if (any (maxloc (a4, 1, l1, 4, .false.) .ne. 1)) stop 17
+ if (any (maxloc (a4, 1, l1, 2, .true.) .ne. 10)) stop 18
+ if (any (maxloc (a4, 1, l3) .ne. 1)) stop 19
+ if (any (maxloc (a4, 1, l3, back=.false.) .ne. 1)) stop 20
+ if (any (maxloc (a4, 1, l3, back=.true.) .ne. 10)) stop 21
+ if (any (maxloc (a4, 1, l3, kind=8) .ne. 1)) stop 22
+ if (any (maxloc (a4, 1, l3, 4, .false.) .ne. 1)) stop 23
+ if (any (maxloc (a4, 1, l3, 2, .true.) .ne. 10)) stop 24
+ b4 = 0
+ if (any (maxloc (b4) .ne. 1)) stop 1
+ if (any (maxloc (b4, back=.false.) .ne. 1)) stop 2
+ if (any (maxloc (b4, back=.true.) .ne. 10)) stop 3
+ if (any (maxloc (b4, kind=2) .ne. 1)) stop 4
+ if (any (maxloc (b4, kind=4, back=.false.) .ne. 1)) stop 5
+ if (any (maxloc (b4, kind=8, back=.true.) .ne. 10)) stop 6
+ if (maxloc (b4, 1) .ne. 1) stop 7
+ if (maxloc (b4, 1, back=.false.) .ne. 1) stop 8
+ if (maxloc (b4, 1, back=.true.) .ne. 10) stop 9
+ if (maxloc (b4, 1, kind=1) .ne. 1) stop 10
+ if (maxloc (b4, 1, kind=2, back=.false.) .ne. 1) stop 11
+ if (maxloc (b4, 1, kind=4, back=.true.) .ne. 10) stop 12
+ if (maxloc (b4, 1, l2) .ne. 1) stop 13
+ if (maxloc (b4, 1, l2, back=.false.) .ne. 1) stop 14
+ if (maxloc (b4, 1, l2, back=.true.) .ne. 10) stop 15
+ if (maxloc (b4, 1, l2, kind=8) .ne. 1) stop 16
+ if (maxloc (b4, 1, l2, 4, .false.) .ne. 1) stop 17
+ if (maxloc (b4, 1, l2, 2, .true.) .ne. 10) stop 18
+ if (maxloc (b4, 1, l3) .ne. 1) stop 19
+ if (maxloc (b4, 1, l3, back=.false.) .ne. 1) stop 20
+ if (maxloc (b4, 1, l3, back=.true.) .ne. 10) stop 21
+ if (maxloc (b4, 1, l3, kind=8) .ne. 1) stop 22
+ if (maxloc (b4, 1, l3, 4, .false.) .ne. 1) stop 23
+ if (maxloc (b4, 1, l3, 2, .true.) .ne. 10) stop 24
+ a8 = 0
+ if (any (maxloc (a8) .ne. 1)) stop 1
+ if (any (maxloc (a8, back=.false.) .ne. 1)) stop 2
+ if (any (maxloc (a8, back=.true.) .ne. 10)) stop 3
+ if (any (maxloc (a8, kind=2) .ne. 1)) stop 4
+ if (any (maxloc (a8, kind=4, back=.false.) .ne. 1)) stop 5
+ if (any (maxloc (a8, kind=8, back=.true.) .ne. 10)) stop 6
+ if (any (maxloc (a8, 1) .ne. 1)) stop 7
+ if (any (maxloc (a8, 1, back=.false.) .ne. 1)) stop 8
+ if (any (maxloc (a8, 1, back=.true.) .ne. 10)) stop 9
+ if (any (maxloc (a8, 1, kind=1) .ne. 1)) stop 10
+ if (any (maxloc (a8, 1, kind=2, back=.false.) .ne. 1)) stop 11
+ if (any (maxloc (a8, 1, kind=4, back=.true.) .ne. 10)) stop 12
+ if (any (maxloc (a8, 1, l1) .ne. 1)) stop 13
+ if (any (maxloc (a8, 1, l1, back=.false.) .ne. 1)) stop 14
+ if (any (maxloc (a8, 1, l1, back=.true.) .ne. 10)) stop 15
+ if (any (maxloc (a8, 1, l1, kind=8) .ne. 1)) stop 16
+ if (any (maxloc (a8, 1, l1, 4, .false.) .ne. 1)) stop 17
+ if (any (maxloc (a8, 1, l1, 2, .true.) .ne. 10)) stop 18
+ if (any (maxloc (a8, 1, l3) .ne. 1)) stop 19
+ if (any (maxloc (a8, 1, l3, back=.false.) .ne. 1)) stop 20
+ if (any (maxloc (a8, 1, l3, back=.true.) .ne. 10)) stop 21
+ if (any (maxloc (a8, 1, l3, kind=8) .ne. 1)) stop 22
+ if (any (maxloc (a8, 1, l3, 4, .false.) .ne. 1)) stop 23
+ if (any (maxloc (a8, 1, l3, 2, .true.) .ne. 10)) stop 24
+ b8 = 0
+ if (any (maxloc (b8) .ne. 1)) stop 1
+ if (any (maxloc (b8, back=.false.) .ne. 1)) stop 2
+ if (any (maxloc (b8, back=.true.) .ne. 10)) stop 3
+ if (any (maxloc (b8, kind=2) .ne. 1)) stop 4
+ if (any (maxloc (b8, kind=4, back=.false.) .ne. 1)) stop 5
+ if (any (maxloc (b8, kind=8, back=.true.) .ne. 10)) stop 6
+ if (maxloc (b8, 1) .ne. 1) stop 7
+ if (maxloc (b8, 1, back=.false.) .ne. 1) stop 8
+ if (maxloc (b8, 1, back=.true.) .ne. 10) stop 9
+ if (maxloc (b8, 1, kind=1) .ne. 1) stop 10
+ if (maxloc (b8, 1, kind=2, back=.false.) .ne. 1) stop 11
+ if (maxloc (b8, 1, kind=4, back=.true.) .ne. 10) stop 12
+ if (maxloc (b8, 1, l2) .ne. 1) stop 13
+ if (maxloc (b8, 1, l2, back=.false.) .ne. 1) stop 14
+ if (maxloc (b8, 1, l2, back=.true.) .ne. 10) stop 15
+ if (maxloc (b8, 1, l2, kind=8) .ne. 1) stop 16
+ if (maxloc (b8, 1, l2, 4, .false.) .ne. 1) stop 17
+ if (maxloc (b8, 1, l2, 2, .true.) .ne. 10) stop 18
+ if (maxloc (b8, 1, l3) .ne. 1) stop 19
+ if (maxloc (b8, 1, l3, back=.false.) .ne. 1) stop 20
+ if (maxloc (b8, 1, l3, back=.true.) .ne. 10) stop 21
+ if (maxloc (b8, 1, l3, kind=8) .ne. 1) stop 22
+ if (maxloc (b8, 1, l3, 4, .false.) .ne. 1) stop 23
+ if (maxloc (b8, 1, l3, 2, .true.) .ne. 10) stop 24
+ r4 = 0.0
+ if (any (maxloc (r4) .ne. 1)) stop 1
+ if (any (maxloc (r4, back=.false.) .ne. 1)) stop 2
+ if (any (maxloc (r4, back=.true.) .ne. 10)) stop 3
+ if (any (maxloc (r4, kind=2) .ne. 1)) stop 4
+ if (any (maxloc (r4, kind=4, back=.false.) .ne. 1)) stop 5
+ if (any (maxloc (r4, kind=8, back=.true.) .ne. 10)) stop 6
+ if (any (maxloc (r4, 1) .ne. 1)) stop 7
+ if (any (maxloc (r4, 1, back=.false.) .ne. 1)) stop 8
+ if (any (maxloc (r4, 1, back=.true.) .ne. 10)) stop 9
+ if (any (maxloc (r4, 1, kind=1) .ne. 1)) stop 10
+ if (any (maxloc (r4, 1, kind=2, back=.false.) .ne. 1)) stop 11
+ if (any (maxloc (r4, 1, kind=4, back=.true.) .ne. 10)) stop 12
+ if (any (maxloc (r4, 1, l1) .ne. 1)) stop 13
+ if (any (maxloc (r4, 1, l1, back=.false.) .ne. 1)) stop 14
+ if (any (maxloc (r4, 1, l1, back=.true.) .ne. 10)) stop 15
+ if (any (maxloc (r4, 1, l1, kind=8) .ne. 1)) stop 16
+ if (any (maxloc (r4, 1, l1, 4, .false.) .ne. 1)) stop 17
+ if (any (maxloc (r4, 1, l1, 2, .true.) .ne. 10)) stop 18
+ if (any (maxloc (r4, 1, l3) .ne. 1)) stop 19
+ if (any (maxloc (r4, 1, l3, back=.false.) .ne. 1)) stop 20
+ if (any (maxloc (r4, 1, l3, back=.true.) .ne. 10)) stop 21
+ if (any (maxloc (r4, 1, l3, kind=8) .ne. 1)) stop 22
+ if (any (maxloc (r4, 1, l3, 4, .false.) .ne. 1)) stop 23
+ if (any (maxloc (r4, 1, l3, 2, .true.) .ne. 10)) stop 24
+ s4 = 0.0
+ if (any (maxloc (s4) .ne. 1)) stop 1
+ if (any (maxloc (s4, back=.false.) .ne. 1)) stop 2
+ if (any (maxloc (s4, back=.true.) .ne. 10)) stop 3
+ if (any (maxloc (s4, kind=2) .ne. 1)) stop 4
+ if (any (maxloc (s4, kind=4, back=.false.) .ne. 1)) stop 5
+ if (any (maxloc (s4, kind=8, back=.true.) .ne. 10)) stop 6
+ if (maxloc (s4, 1) .ne. 1) stop 7
+ if (maxloc (s4, 1, back=.false.) .ne. 1) stop 8
+ if (maxloc (s4, 1, back=.true.) .ne. 10) stop 9
+ if (maxloc (s4, 1, kind=1) .ne. 1) stop 10
+ if (maxloc (s4, 1, kind=2, back=.false.) .ne. 1) stop 11
+ if (maxloc (s4, 1, kind=4, back=.true.) .ne. 10) stop 12
+ if (maxloc (s4, 1, l2) .ne. 1) stop 13
+ if (maxloc (s4, 1, l2, back=.false.) .ne. 1) stop 14
+ if (maxloc (s4, 1, l2, back=.true.) .ne. 10) stop 15
+ if (maxloc (s4, 1, l2, kind=8) .ne. 1) stop 16
+ if (maxloc (s4, 1, l2, 4, .false.) .ne. 1) stop 17
+ if (maxloc (s4, 1, l2, 2, .true.) .ne. 10) stop 18
+ if (maxloc (s4, 1, l3) .ne. 1) stop 19
+ if (maxloc (s4, 1, l3, back=.false.) .ne. 1) stop 20
+ if (maxloc (s4, 1, l3, back=.true.) .ne. 10) stop 21
+ if (maxloc (s4, 1, l3, kind=8) .ne. 1) stop 22
+ if (maxloc (s4, 1, l3, 4, .false.) .ne. 1) stop 23
+ if (maxloc (s4, 1, l3, 2, .true.) .ne. 10) stop 24
+ r8 = 0.0
+ if (any (maxloc (r8) .ne. 1)) stop 1
+ if (any (maxloc (r8, back=.false.) .ne. 1)) stop 2
+ if (any (maxloc (r8, back=.true.) .ne. 10)) stop 3
+ if (any (maxloc (r8, kind=2) .ne. 1)) stop 4
+ if (any (maxloc (r8, kind=4, back=.false.) .ne. 1)) stop 5
+ if (any (maxloc (r8, kind=8, back=.true.) .ne. 10)) stop 6
+ if (any (maxloc (r8, 1) .ne. 1)) stop 7
+ if (any (maxloc (r8, 1, back=.false.) .ne. 1)) stop 8
+ if (any (maxloc (r8, 1, back=.true.) .ne. 10)) stop 9
+ if (any (maxloc (r8, 1, kind=1) .ne. 1)) stop 10
+ if (any (maxloc (r8, 1, kind=2, back=.false.) .ne. 1)) stop 11
+ if (any (maxloc (r8, 1, kind=4, back=.true.) .ne. 10)) stop 12
+ if (any (maxloc (r8, 1, l1) .ne. 1)) stop 13
+ if (any (maxloc (r8, 1, l1, back=.false.) .ne. 1)) stop 14
+ if (any (maxloc (r8, 1, l1, back=.true.) .ne. 10)) stop 15
+ if (any (maxloc (r8, 1, l1, kind=8) .ne. 1)) stop 16
+ if (any (maxloc (r8, 1, l1, 4, .false.) .ne. 1)) stop 17
+ if (any (maxloc (r8, 1, l1, 2, .true.) .ne. 10)) stop 18
+ if (any (maxloc (r8, 1, l3) .ne. 1)) stop 19
+ if (any (maxloc (r8, 1, l3, back=.false.) .ne. 1)) stop 20
+ if (any (maxloc (r8, 1, l3, back=.true.) .ne. 10)) stop 21
+ if (any (maxloc (r8, 1, l3, kind=8) .ne. 1)) stop 22
+ if (any (maxloc (r8, 1, l3, 4, .false.) .ne. 1)) stop 23
+ if (any (maxloc (r8, 1, l3, 2, .true.) .ne. 10)) stop 24
+ s8 = 0.0
+ if (any (maxloc (s8) .ne. 1)) stop 1
+ if (any (maxloc (s8, back=.false.) .ne. 1)) stop 2
+ if (any (maxloc (s8, back=.true.) .ne. 10)) stop 3
+ if (any (maxloc (s8, kind=2) .ne. 1)) stop 4
+ if (any (maxloc (s8, kind=4, back=.false.) .ne. 1)) stop 5
+ if (any (maxloc (s8, kind=8, back=.true.) .ne. 10)) stop 6
+ if (maxloc (s8, 1) .ne. 1) stop 7
+ if (maxloc (s8, 1, back=.false.) .ne. 1) stop 8
+ if (maxloc (s8, 1, back=.true.) .ne. 10) stop 9
+ if (maxloc (s8, 1, kind=1) .ne. 1) stop 10
+ if (maxloc (s8, 1, kind=2, back=.false.) .ne. 1) stop 11
+ if (maxloc (s8, 1, kind=4, back=.true.) .ne. 10) stop 12
+ if (maxloc (s8, 1, l2) .ne. 1) stop 13
+ if (maxloc (s8, 1, l2, back=.false.) .ne. 1) stop 14
+ if (maxloc (s8, 1, l2, back=.true.) .ne. 10) stop 15
+ if (maxloc (s8, 1, l2, kind=8) .ne. 1) stop 16
+ if (maxloc (s8, 1, l2, 4, .false.) .ne. 1) stop 17
+ if (maxloc (s8, 1, l2, 2, .true.) .ne. 10) stop 18
+ if (maxloc (s8, 1, l3) .ne. 1) stop 19
+ if (maxloc (s8, 1, l3, back=.false.) .ne. 1) stop 20
+ if (maxloc (s8, 1, l3, back=.true.) .ne. 10) stop 21
+ if (maxloc (s8, 1, l3, kind=8) .ne. 1) stop 22
+ if (maxloc (s8, 1, l3, 4, .false.) .ne. 1) stop 23
+ if (maxloc (s8, 1, l3, 2, .true.) .ne. 10) stop 24
+ a1 = 0
+ if (any (minloc (a1) .ne. 1)) stop 1
+ if (any (minloc (a1, back=.false.) .ne. 1)) stop 2
+ if (any (minloc (a1, back=.true.) .ne. 10)) stop 3
+ if (any (minloc (a1, kind=2) .ne. 1)) stop 4
+ if (any (minloc (a1, kind=4, back=.false.) .ne. 1)) stop 5
+ if (any (minloc (a1, kind=8, back=.true.) .ne. 10)) stop 6
+ if (any (minloc (a1, 1) .ne. 1)) stop 7
+ if (any (minloc (a1, 1, back=.false.) .ne. 1)) stop 8
+ if (any (minloc (a1, 1, back=.true.) .ne. 10)) stop 9
+ if (any (minloc (a1, 1, kind=1) .ne. 1)) stop 10
+ if (any (minloc (a1, 1, kind=2, back=.false.) .ne. 1)) stop 11
+ if (any (minloc (a1, 1, kind=4, back=.true.) .ne. 10)) stop 12
+ if (any (minloc (a1, 1, l1) .ne. 1)) stop 13
+ if (any (minloc (a1, 1, l1, back=.false.) .ne. 1)) stop 14
+ if (any (minloc (a1, 1, l1, back=.true.) .ne. 10)) stop 15
+ if (any (minloc (a1, 1, l1, kind=8) .ne. 1)) stop 16
+ if (any (minloc (a1, 1, l1, 4, .false.) .ne. 1)) stop 17
+ if (any (minloc (a1, 1, l1, 2, .true.) .ne. 10)) stop 18
+ if (any (minloc (a1, 1, l3) .ne. 1)) stop 19
+ if (any (minloc (a1, 1, l3, back=.false.) .ne. 1)) stop 20
+ if (any (minloc (a1, 1, l3, back=.true.) .ne. 10)) stop 21
+ if (any (minloc (a1, 1, l3, kind=8) .ne. 1)) stop 22
+ if (any (minloc (a1, 1, l3, 4, .false.) .ne. 1)) stop 23
+ if (any (minloc (a1, 1, l3, 2, .true.) .ne. 10)) stop 24
+ b1 = 0
+ if (any (minloc (b1) .ne. 1)) stop 1
+ if (any (minloc (b1, back=.false.) .ne. 1)) stop 2
+ if (any (minloc (b1, back=.true.) .ne. 10)) stop 3
+ if (any (minloc (b1, kind=2) .ne. 1)) stop 4
+ if (any (minloc (b1, kind=4, back=.false.) .ne. 1)) stop 5
+ if (any (minloc (b1, kind=8, back=.true.) .ne. 10)) stop 6
+ if (minloc (b1, 1) .ne. 1) stop 7
+ if (minloc (b1, 1, back=.false.) .ne. 1) stop 8
+ if (minloc (b1, 1, back=.true.) .ne. 10) stop 9
+ if (minloc (b1, 1, kind=1) .ne. 1) stop 10
+ if (minloc (b1, 1, kind=2, back=.false.) .ne. 1) stop 11
+ if (minloc (b1, 1, kind=4, back=.true.) .ne. 10) stop 12
+ if (minloc (b1, 1, l2) .ne. 1) stop 13
+ if (minloc (b1, 1, l2, back=.false.) .ne. 1) stop 14
+ if (minloc (b1, 1, l2, back=.true.) .ne. 10) stop 15
+ if (minloc (b1, 1, l2, kind=8) .ne. 1) stop 16
+ if (minloc (b1, 1, l2, 4, .false.) .ne. 1) stop 17
+ if (minloc (b1, 1, l2, 2, .true.) .ne. 10) stop 18
+ if (minloc (b1, 1, l3) .ne. 1) stop 19
+ if (minloc (b1, 1, l3, back=.false.) .ne. 1) stop 20
+ if (minloc (b1, 1, l3, back=.true.) .ne. 10) stop 21
+ if (minloc (b1, 1, l3, kind=8) .ne. 1) stop 22
+ if (minloc (b1, 1, l3, 4, .false.) .ne. 1) stop 23
+ if (minloc (b1, 1, l3, 2, .true.) .ne. 10) stop 24
+ a2 = 0
+ if (any (minloc (a2) .ne. 1)) stop 1
+ if (any (minloc (a2, back=.false.) .ne. 1)) stop 2
+ if (any (minloc (a2, back=.true.) .ne. 10)) stop 3
+ if (any (minloc (a2, kind=2) .ne. 1)) stop 4
+ if (any (minloc (a2, kind=4, back=.false.) .ne. 1)) stop 5
+ if (any (minloc (a2, kind=8, back=.true.) .ne. 10)) stop 6
+ if (any (minloc (a2, 1) .ne. 1)) stop 7
+ if (any (minloc (a2, 1, back=.false.) .ne. 1)) stop 8
+ if (any (minloc (a2, 1, back=.true.) .ne. 10)) stop 9
+ if (any (minloc (a2, 1, kind=1) .ne. 1)) stop 10
+ if (any (minloc (a2, 1, kind=2, back=.false.) .ne. 1)) stop 11
+ if (any (minloc (a2, 1, kind=4, back=.true.) .ne. 10)) stop 12
+ if (any (minloc (a2, 1, l1) .ne. 1)) stop 13
+ if (any (minloc (a2, 1, l1, back=.false.) .ne. 1)) stop 14
+ if (any (minloc (a2, 1, l1, back=.true.) .ne. 10)) stop 15
+ if (any (minloc (a2, 1, l1, kind=8) .ne. 1)) stop 16
+ if (any (minloc (a2, 1, l1, 4, .false.) .ne. 1)) stop 17
+ if (any (minloc (a2, 1, l1, 2, .true.) .ne. 10)) stop 18
+ if (any (minloc (a2, 1, l3) .ne. 1)) stop 19
+ if (any (minloc (a2, 1, l3, back=.false.) .ne. 1)) stop 20
+ if (any (minloc (a2, 1, l3, back=.true.) .ne. 10)) stop 21
+ if (any (minloc (a2, 1, l3, kind=8) .ne. 1)) stop 22
+ if (any (minloc (a2, 1, l3, 4, .false.) .ne. 1)) stop 23
+ if (any (minloc (a2, 1, l3, 2, .true.) .ne. 10)) stop 24
+ b2 = 0
+ if (any (minloc (b2) .ne. 1)) stop 1
+ if (any (minloc (b2, back=.false.) .ne. 1)) stop 2
+ if (any (minloc (b2, back=.true.) .ne. 10)) stop 3
+ if (any (minloc (b2, kind=2) .ne. 1)) stop 4
+ if (any (minloc (b2, kind=4, back=.false.) .ne. 1)) stop 5
+ if (any (minloc (b2, kind=8, back=.true.) .ne. 10)) stop 6
+ if (minloc (b2, 1) .ne. 1) stop 7
+ if (minloc (b2, 1, back=.false.) .ne. 1) stop 8
+ if (minloc (b2, 1, back=.true.) .ne. 10) stop 9
+ if (minloc (b2, 1, kind=1) .ne. 1) stop 10
+ if (minloc (b2, 1, kind=2, back=.false.) .ne. 1) stop 11
+ if (minloc (b2, 1, kind=4, back=.true.) .ne. 10) stop 12
+ if (minloc (b2, 1, l2) .ne. 1) stop 13
+ if (minloc (b2, 1, l2, back=.false.) .ne. 1) stop 14
+ if (minloc (b2, 1, l2, back=.true.) .ne. 10) stop 15
+ if (minloc (b2, 1, l2, kind=8) .ne. 1) stop 16
+ if (minloc (b2, 1, l2, 4, .false.) .ne. 1) stop 17
+ if (minloc (b2, 1, l2, 2, .true.) .ne. 10) stop 18
+ if (minloc (b2, 1, l3) .ne. 1) stop 19
+ if (minloc (b2, 1, l3, back=.false.) .ne. 1) stop 20
+ if (minloc (b2, 1, l3, back=.true.) .ne. 10) stop 21
+ if (minloc (b2, 1, l3, kind=8) .ne. 1) stop 22
+ if (minloc (b2, 1, l3, 4, .false.) .ne. 1) stop 23
+ if (minloc (b2, 1, l3, 2, .true.) .ne. 10) stop 24
+ a4 = 0
+ if (any (minloc (a4) .ne. 1)) stop 1
+ if (any (minloc (a4, back=.false.) .ne. 1)) stop 2
+ if (any (minloc (a4, back=.true.) .ne. 10)) stop 3
+ if (any (minloc (a4, kind=2) .ne. 1)) stop 4
+ if (any (minloc (a4, kind=4, back=.false.) .ne. 1)) stop 5
+ if (any (minloc (a4, kind=8, back=.true.) .ne. 10)) stop 6
+ if (any (minloc (a4, 1) .ne. 1)) stop 7
+ if (any (minloc (a4, 1, back=.false.) .ne. 1)) stop 8
+ if (any (minloc (a4, 1, back=.true.) .ne. 10)) stop 9
+ if (any (minloc (a4, 1, kind=1) .ne. 1)) stop 10
+ if (any (minloc (a4, 1, kind=2, back=.false.) .ne. 1)) stop 11
+ if (any (minloc (a4, 1, kind=4, back=.true.) .ne. 10)) stop 12
+ if (any (minloc (a4, 1, l1) .ne. 1)) stop 13
+ if (any (minloc (a4, 1, l1, back=.false.) .ne. 1)) stop 14
+ if (any (minloc (a4, 1, l1, back=.true.) .ne. 10)) stop 15
+ if (any (minloc (a4, 1, l1, kind=8) .ne. 1)) stop 16
+ if (any (minloc (a4, 1, l1, 4, .false.) .ne. 1)) stop 17
+ if (any (minloc (a4, 1, l1, 2, .true.) .ne. 10)) stop 18
+ if (any (minloc (a4, 1, l3) .ne. 1)) stop 19
+ if (any (minloc (a4, 1, l3, back=.false.) .ne. 1)) stop 20
+ if (any (minloc (a4, 1, l3, back=.true.) .ne. 10)) stop 21
+ if (any (minloc (a4, 1, l3, kind=8) .ne. 1)) stop 22
+ if (any (minloc (a4, 1, l3, 4, .false.) .ne. 1)) stop 23
+ if (any (minloc (a4, 1, l3, 2, .true.) .ne. 10)) stop 24
+ b4 = 0
+ if (any (minloc (b4) .ne. 1)) stop 1
+ if (any (minloc (b4, back=.false.) .ne. 1)) stop 2
+ if (any (minloc (b4, back=.true.) .ne. 10)) stop 3
+ if (any (minloc (b4, kind=2) .ne. 1)) stop 4
+ if (any (minloc (b4, kind=4, back=.false.) .ne. 1)) stop 5
+ if (any (minloc (b4, kind=8, back=.true.) .ne. 10)) stop 6
+ if (minloc (b4, 1) .ne. 1) stop 7
+ if (minloc (b4, 1, back=.false.) .ne. 1) stop 8
+ if (minloc (b4, 1, back=.true.) .ne. 10) stop 9
+ if (minloc (b4, 1, kind=1) .ne. 1) stop 10
+ if (minloc (b4, 1, kind=2, back=.false.) .ne. 1) stop 11
+ if (minloc (b4, 1, kind=4, back=.true.) .ne. 10) stop 12
+ if (minloc (b4, 1, l2) .ne. 1) stop 13
+ if (minloc (b4, 1, l2, back=.false.) .ne. 1) stop 14
+ if (minloc (b4, 1, l2, back=.true.) .ne. 10) stop 15
+ if (minloc (b4, 1, l2, kind=8) .ne. 1) stop 16
+ if (minloc (b4, 1, l2, 4, .false.) .ne. 1) stop 17
+ if (minloc (b4, 1, l2, 2, .true.) .ne. 10) stop 18
+ if (minloc (b4, 1, l3) .ne. 1) stop 19
+ if (minloc (b4, 1, l3, back=.false.) .ne. 1) stop 20
+ if (minloc (b4, 1, l3, back=.true.) .ne. 10) stop 21
+ if (minloc (b4, 1, l3, kind=8) .ne. 1) stop 22
+ if (minloc (b4, 1, l3, 4, .false.) .ne. 1) stop 23
+ if (minloc (b4, 1, l3, 2, .true.) .ne. 10) stop 24
+ a8 = 0
+ if (any (minloc (a8) .ne. 1)) stop 1
+ if (any (minloc (a8, back=.false.) .ne. 1)) stop 2
+ if (any (minloc (a8, back=.true.) .ne. 10)) stop 3
+ if (any (minloc (a8, kind=2) .ne. 1)) stop 4
+ if (any (minloc (a8, kind=4, back=.false.) .ne. 1)) stop 5
+ if (any (minloc (a8, kind=8, back=.true.) .ne. 10)) stop 6
+ if (any (minloc (a8, 1) .ne. 1)) stop 7
+ if (any (minloc (a8, 1, back=.false.) .ne. 1)) stop 8
+ if (any (minloc (a8, 1, back=.true.) .ne. 10)) stop 9
+ if (any (minloc (a8, 1, kind=1) .ne. 1)) stop 10
+ if (any (minloc (a8, 1, kind=2, back=.false.) .ne. 1)) stop 11
+ if (any (minloc (a8, 1, kind=4, back=.true.) .ne. 10)) stop 12
+ if (any (minloc (a8, 1, l1) .ne. 1)) stop 13
+ if (any (minloc (a8, 1, l1, back=.false.) .ne. 1)) stop 14
+ if (any (minloc (a8, 1, l1, back=.true.) .ne. 10)) stop 15
+ if (any (minloc (a8, 1, l1, kind=8) .ne. 1)) stop 16
+ if (any (minloc (a8, 1, l1, 4, .false.) .ne. 1)) stop 17
+ if (any (minloc (a8, 1, l1, 2, .true.) .ne. 10)) stop 18
+ if (any (minloc (a8, 1, l3) .ne. 1)) stop 19
+ if (any (minloc (a8, 1, l3, back=.false.) .ne. 1)) stop 20
+ if (any (minloc (a8, 1, l3, back=.true.) .ne. 10)) stop 21
+ if (any (minloc (a8, 1, l3, kind=8) .ne. 1)) stop 22
+ if (any (minloc (a8, 1, l3, 4, .false.) .ne. 1)) stop 23
+ if (any (minloc (a8, 1, l3, 2, .true.) .ne. 10)) stop 24
+ b8 = 0
+ if (any (minloc (b8) .ne. 1)) stop 1
+ if (any (minloc (b8, back=.false.) .ne. 1)) stop 2
+ if (any (minloc (b8, back=.true.) .ne. 10)) stop 3
+ if (any (minloc (b8, kind=2) .ne. 1)) stop 4
+ if (any (minloc (b8, kind=4, back=.false.) .ne. 1)) stop 5
+ if (any (minloc (b8, kind=8, back=.true.) .ne. 10)) stop 6
+ if (minloc (b8, 1) .ne. 1) stop 7
+ if (minloc (b8, 1, back=.false.) .ne. 1) stop 8
+ if (minloc (b8, 1, back=.true.) .ne. 10) stop 9
+ if (minloc (b8, 1, kind=1) .ne. 1) stop 10
+ if (minloc (b8, 1, kind=2, back=.false.) .ne. 1) stop 11
+ if (minloc (b8, 1, kind=4, back=.true.) .ne. 10) stop 12
+ if (minloc (b8, 1, l2) .ne. 1) stop 13
+ if (minloc (b8, 1, l2, back=.false.) .ne. 1) stop 14
+ if (minloc (b8, 1, l2, back=.true.) .ne. 10) stop 15
+ if (minloc (b8, 1, l2, kind=8) .ne. 1) stop 16
+ if (minloc (b8, 1, l2, 4, .false.) .ne. 1) stop 17
+ if (minloc (b8, 1, l2, 2, .true.) .ne. 10) stop 18
+ if (minloc (b8, 1, l3) .ne. 1) stop 19
+ if (minloc (b8, 1, l3, back=.false.) .ne. 1) stop 20
+ if (minloc (b8, 1, l3, back=.true.) .ne. 10) stop 21
+ if (minloc (b8, 1, l3, kind=8) .ne. 1) stop 22
+ if (minloc (b8, 1, l3, 4, .false.) .ne. 1) stop 23
+ if (minloc (b8, 1, l3, 2, .true.) .ne. 10) stop 24
+ r4 = 0.0
+ if (any (minloc (r4) .ne. 1)) stop 1
+ if (any (minloc (r4, back=.false.) .ne. 1)) stop 2
+ if (any (minloc (r4, back=.true.) .ne. 10)) stop 3
+ if (any (minloc (r4, kind=2) .ne. 1)) stop 4
+ if (any (minloc (r4, kind=4, back=.false.) .ne. 1)) stop 5
+ if (any (minloc (r4, kind=8, back=.true.) .ne. 10)) stop 6
+ if (any (minloc (r4, 1) .ne. 1)) stop 7
+ if (any (minloc (r4, 1, back=.false.) .ne. 1)) stop 8
+ if (any (minloc (r4, 1, back=.true.) .ne. 10)) stop 9
+ if (any (minloc (r4, 1, kind=1) .ne. 1)) stop 10
+ if (any (minloc (r4, 1, kind=2, back=.false.) .ne. 1)) stop 11
+ if (any (minloc (r4, 1, kind=4, back=.true.) .ne. 10)) stop 12
+ if (any (minloc (r4, 1, l1) .ne. 1)) stop 13
+ if (any (minloc (r4, 1, l1, back=.false.) .ne. 1)) stop 14
+ if (any (minloc (r4, 1, l1, back=.true.) .ne. 10)) stop 15
+ if (any (minloc (r4, 1, l1, kind=8) .ne. 1)) stop 16
+ if (any (minloc (r4, 1, l1, 4, .false.) .ne. 1)) stop 17
+ if (any (minloc (r4, 1, l1, 2, .true.) .ne. 10)) stop 18
+ if (any (minloc (r4, 1, l3) .ne. 1)) stop 19
+ if (any (minloc (r4, 1, l3, back=.false.) .ne. 1)) stop 20
+ if (any (minloc (r4, 1, l3, back=.true.) .ne. 10)) stop 21
+ if (any (minloc (r4, 1, l3, kind=8) .ne. 1)) stop 22
+ if (any (minloc (r4, 1, l3, 4, .false.) .ne. 1)) stop 23
+ if (any (minloc (r4, 1, l3, 2, .true.) .ne. 10)) stop 24
+ s4 = 0.0
+ if (any (minloc (s4) .ne. 1)) stop 1
+ if (any (minloc (s4, back=.false.) .ne. 1)) stop 2
+ if (any (minloc (s4, back=.true.) .ne. 10)) stop 3
+ if (any (minloc (s4, kind=2) .ne. 1)) stop 4
+ if (any (minloc (s4, kind=4, back=.false.) .ne. 1)) stop 5
+ if (any (minloc (s4, kind=8, back=.true.) .ne. 10)) stop 6
+ if (minloc (s4, 1) .ne. 1) stop 7
+ if (minloc (s4, 1, back=.false.) .ne. 1) stop 8
+ if (minloc (s4, 1, back=.true.) .ne. 10) stop 9
+ if (minloc (s4, 1, kind=1) .ne. 1) stop 10
+ if (minloc (s4, 1, kind=2, back=.false.) .ne. 1) stop 11
+ if (minloc (s4, 1, kind=4, back=.true.) .ne. 10) stop 12
+ if (minloc (s4, 1, l2) .ne. 1) stop 13
+ if (minloc (s4, 1, l2, back=.false.) .ne. 1) stop 14
+ if (minloc (s4, 1, l2, back=.true.) .ne. 10) stop 15
+ if (minloc (s4, 1, l2, kind=8) .ne. 1) stop 16
+ if (minloc (s4, 1, l2, 4, .false.) .ne. 1) stop 17
+ if (minloc (s4, 1, l2, 2, .true.) .ne. 10) stop 18
+ if (minloc (s4, 1, l3) .ne. 1) stop 19
+ if (minloc (s4, 1, l3, back=.false.) .ne. 1) stop 20
+ if (minloc (s4, 1, l3, back=.true.) .ne. 10) stop 21
+ if (minloc (s4, 1, l3, kind=8) .ne. 1) stop 22
+ if (minloc (s4, 1, l3, 4, .false.) .ne. 1) stop 23
+ if (minloc (s4, 1, l3, 2, .true.) .ne. 10) stop 24
+ r8 = 0.0
+ if (any (minloc (r8) .ne. 1)) stop 1
+ if (any (minloc (r8, back=.false.) .ne. 1)) stop 2
+ if (any (minloc (r8, back=.true.) .ne. 10)) stop 3
+ if (any (minloc (r8, kind=2) .ne. 1)) stop 4
+ if (any (minloc (r8, kind=4, back=.false.) .ne. 1)) stop 5
+ if (any (minloc (r8, kind=8, back=.true.) .ne. 10)) stop 6
+ if (any (minloc (r8, 1) .ne. 1)) stop 7
+ if (any (minloc (r8, 1, back=.false.) .ne. 1)) stop 8
+ if (any (minloc (r8, 1, back=.true.) .ne. 10)) stop 9
+ if (any (minloc (r8, 1, kind=1) .ne. 1)) stop 10
+ if (any (minloc (r8, 1, kind=2, back=.false.) .ne. 1)) stop 11
+ if (any (minloc (r8, 1, kind=4, back=.true.) .ne. 10)) stop 12
+ if (any (minloc (r8, 1, l1) .ne. 1)) stop 13
+ if (any (minloc (r8, 1, l1, back=.false.) .ne. 1)) stop 14
+ if (any (minloc (r8, 1, l1, back=.true.) .ne. 10)) stop 15
+ if (any (minloc (r8, 1, l1, kind=8) .ne. 1)) stop 16
+ if (any (minloc (r8, 1, l1, 4, .false.) .ne. 1)) stop 17
+ if (any (minloc (r8, 1, l1, 2, .true.) .ne. 10)) stop 18
+ if (any (minloc (r8, 1, l3) .ne. 1)) stop 19
+ if (any (minloc (r8, 1, l3, back=.false.) .ne. 1)) stop 20
+ if (any (minloc (r8, 1, l3, back=.true.) .ne. 10)) stop 21
+ if (any (minloc (r8, 1, l3, kind=8) .ne. 1)) stop 22
+ if (any (minloc (r8, 1, l3, 4, .false.) .ne. 1)) stop 23
+ if (any (minloc (r8, 1, l3, 2, .true.) .ne. 10)) stop 24
+ s8 = 0.0
+ if (any (minloc (s8) .ne. 1)) stop 1
+ if (any (minloc (s8, back=.false.) .ne. 1)) stop 2
+ if (any (minloc (s8, back=.true.) .ne. 10)) stop 3
+ if (any (minloc (s8, kind=2) .ne. 1)) stop 4
+ if (any (minloc (s8, kind=4, back=.false.) .ne. 1)) stop 5
+ if (any (minloc (s8, kind=8, back=.true.) .ne. 10)) stop 6
+ if (minloc (s8, 1) .ne. 1) stop 7
+ if (minloc (s8, 1, back=.false.) .ne. 1) stop 8
+ if (minloc (s8, 1, back=.true.) .ne. 10) stop 9
+ if (minloc (s8, 1, kind=1) .ne. 1) stop 10
+ if (minloc (s8, 1, kind=2, back=.false.) .ne. 1) stop 11
+ if (minloc (s8, 1, kind=4, back=.true.) .ne. 10) stop 12
+ if (minloc (s8, 1, l2) .ne. 1) stop 13
+ if (minloc (s8, 1, l2, back=.false.) .ne. 1) stop 14
+ if (minloc (s8, 1, l2, back=.true.) .ne. 10) stop 15
+ if (minloc (s8, 1, l2, kind=8) .ne. 1) stop 16
+ if (minloc (s8, 1, l2, 4, .false.) .ne. 1) stop 17
+ if (minloc (s8, 1, l2, 2, .true.) .ne. 10) stop 18
+ if (minloc (s8, 1, l3) .ne. 1) stop 19
+ if (minloc (s8, 1, l3, back=.false.) .ne. 1) stop 20
+ if (minloc (s8, 1, l3, back=.true.) .ne. 10) stop 21
+ if (minloc (s8, 1, l3, kind=8) .ne. 1) stop 22
+ if (minloc (s8, 1, l3, 4, .false.) .ne. 1) stop 23
+ if (minloc (s8, 1, l3, 2, .true.) .ne. 10) stop 24
+end
diff --git a/gcc/testsuite/gfortran.dg/pr120191_2.f90 b/gcc/testsuite/gfortran.dg/pr120191_2.f90
new file mode 100644
index 0000000..6334286
--- /dev/null
+++ b/gcc/testsuite/gfortran.dg/pr120191_2.f90
@@ -0,0 +1,84 @@
+! PR fortran/120191
+! { dg-do run }
+
+ character(kind=1, len=2) :: a(4, 4, 4), b(4)
+ logical :: l(4, 4, 4), m, n(4)
+ a = 'aa'
+ b = 'aa'
+ l = .true.
+ m = .true.
+ n = .true.
+ if (any (maxloc (a) .ne. 1)) stop 1
+ if (any (maxloc (a, dim=1) .ne. 1)) stop 2
+ if (any (maxloc (a, 1) .ne. 1)) stop 3
+ if (any (maxloc (a, dim=1, mask=l, kind=4, back=.false.) .ne. 1)) stop 4
+ if (any (maxloc (a, 1, l, 4, .false.) .ne. 1)) stop 5
+ if (any (maxloc (a, dim=1, mask=m, kind=4, back=.false.) .ne. 1)) stop 6
+ if (any (maxloc (a, 1, m, 4, .false.) .ne. 1)) stop 7
+ if (any (maxloc (a, dim=1, mask=l, kind=4, back=.true.) .ne. 4)) stop 8
+ if (any (maxloc (a, 1, l, 4, .true.) .ne. 4)) stop 9
+ if (any (maxloc (a, dim=1, mask=m, kind=4, back=.true.) .ne. 4)) stop 10
+ if (any (maxloc (a, 1, m, 4, .true.) .ne. 4)) stop 11
+ if (any (maxloc (b) .ne. 1)) stop 12
+ if (maxloc (b, dim=1) .ne. 1) stop 13
+ if (maxloc (b, 1) .ne. 1) stop 14
+ if (maxloc (b, dim=1, mask=n, kind=4, back=.false.) .ne. 1) stop 15
+ if (maxloc (b, 1, n, 4, .false.) .ne. 1) stop 16
+ if (maxloc (b, dim=1, mask=m, kind=4, back=.false.) .ne. 1) stop 17
+ if (maxloc (b, 1, m, 4, .false.) .ne. 1) stop 18
+ if (maxloc (b, dim=1, mask=n, kind=4, back=.true.) .ne. 4) stop 19
+ if (maxloc (b, 1, n, 4, .true.) .ne. 4) stop 20
+ if (maxloc (b, dim=1, mask=m, kind=4, back=.true.) .ne. 4) stop 21
+ if (maxloc (b, 1, m, 4, .true.) .ne. 4) stop 22
+ l = .false.
+ m = .false.
+ n = .false.
+ if (any (maxloc (a, dim=1, mask=l, kind=4, back=.false.) .ne. 0)) stop 23
+ if (any (maxloc (a, 1, l, 4, .false.) .ne. 0)) stop 24
+ if (maxloc (b, dim=1, mask=n, kind=4, back=.false.) .ne. 0) stop 25
+ if (maxloc (b, 1, n, 4, .false.) .ne. 0) stop 26
+ if (maxloc (b, dim=1, mask=m, kind=4, back=.false.) .ne. 0) stop 27
+ if (maxloc (b, 1, m, 4, .false.) .ne. 0) stop 28
+ if (maxloc (b, dim=1, mask=n, kind=4, back=.true.) .ne. 0) stop 29
+ if (maxloc (b, 1, n, 4, .true.) .ne. 0) stop 30
+ if (maxloc (b, dim=1, mask=m, kind=4, back=.true.) .ne. 0) stop 31
+ if (maxloc (b, 1, m, 4, .true.) .ne. 0) stop 32
+ l = .true.
+ m = .true.
+ n = .true.
+ if (any (minloc (a) .ne. 1)) stop 1
+ if (any (minloc (a, dim=1) .ne. 1)) stop 2
+ if (any (minloc (a, 1) .ne. 1)) stop 3
+ if (any (minloc (a, dim=1, mask=l, kind=4, back=.false.) .ne. 1)) stop 4
+ if (any (minloc (a, 1, l, 4, .false.) .ne. 1)) stop 5
+ if (any (minloc (a, dim=1, mask=m, kind=4, back=.false.) .ne. 1)) stop 6
+ if (any (minloc (a, 1, m, 4, .false.) .ne. 1)) stop 7
+ if (any (minloc (a, dim=1, mask=l, kind=4, back=.true.) .ne. 4)) stop 8
+ if (any (minloc (a, 1, l, 4, .true.) .ne. 4)) stop 9
+ if (any (minloc (a, dim=1, mask=m, kind=4, back=.true.) .ne. 4)) stop 10
+ if (any (minloc (a, 1, m, 4, .true.) .ne. 4)) stop 11
+ if (any (minloc (b) .ne. 1)) stop 12
+ if (minloc (b, dim=1) .ne. 1) stop 13
+ if (minloc (b, 1) .ne. 1) stop 14
+ if (minloc (b, dim=1, mask=n, kind=4, back=.false.) .ne. 1) stop 15
+ if (minloc (b, 1, n, 4, .false.) .ne. 1) stop 16
+ if (minloc (b, dim=1, mask=m, kind=4, back=.false.) .ne. 1) stop 17
+ if (minloc (b, 1, m, 4, .false.) .ne. 1) stop 18
+ if (minloc (b, dim=1, mask=n, kind=4, back=.true.) .ne. 4) stop 19
+ if (minloc (b, 1, n, 4, .true.) .ne. 4) stop 20
+ if (minloc (b, dim=1, mask=m, kind=4, back=.true.) .ne. 4) stop 21
+ if (minloc (b, 1, m, 4, .true.) .ne. 4) stop 22
+ l = .false.
+ m = .false.
+ n = .false.
+ if (any (minloc (a, dim=1, mask=l, kind=4, back=.false.) .ne. 0)) stop 23
+ if (any (minloc (a, 1, l, 4, .false.) .ne. 0)) stop 24
+ if (minloc (b, dim=1, mask=n, kind=4, back=.false.) .ne. 0) stop 25
+ if (minloc (b, 1, n, 4, .false.) .ne. 0) stop 26
+ if (minloc (b, dim=1, mask=m, kind=4, back=.false.) .ne. 0) stop 27
+ if (minloc (b, 1, m, 4, .false.) .ne. 0) stop 28
+ if (minloc (b, dim=1, mask=n, kind=4, back=.true.) .ne. 0) stop 29
+ if (minloc (b, 1, n, 4, .true.) .ne. 0) stop 30
+ if (minloc (b, dim=1, mask=m, kind=4, back=.true.) .ne. 0) stop 31
+ if (minloc (b, 1, m, 4, .true.) .ne. 0) stop 32
+end
diff --git a/gcc/testsuite/gfortran.dg/pr120191_3.f90 b/gcc/testsuite/gfortran.dg/pr120191_3.f90
new file mode 100644
index 0000000..26e4095
--- /dev/null
+++ b/gcc/testsuite/gfortran.dg/pr120191_3.f90
@@ -0,0 +1,23 @@
+! PR fortran/120191
+! { dg-do run }
+
+ character(kind=1, len=2) :: a(4, 4, 4), b(4)
+ logical :: l(4, 4, 4), m, n(4)
+ a = 'aa'
+ b = 'aa'
+ l = .false.
+ m = .false.
+ n = .false.
+ if (any (maxloc (a, dim=1, mask=m, kind=4, back=.false.) .ne. 0)) stop 1
+ if (any (maxloc (a, 1, m, 4, .false.) .ne. 0)) stop 2
+ if (any (maxloc (a, dim=1, mask=l, kind=4, back=.true.) .ne. 0)) stop 3
+ if (any (maxloc (a, 1, l, 4, .true.) .ne. 0)) stop 4
+ if (any (maxloc (a, dim=1, mask=m, kind=4, back=.true.) .ne. 0)) stop 5
+ if (any (maxloc (a, 1, m, 4, .true.) .ne. 0)) stop 6
+ if (any (minloc (a, dim=1, mask=m, kind=4, back=.false.) .ne. 0)) stop 7
+ if (any (minloc (a, 1, m, 4, .false.) .ne. 0)) stop 8
+ if (any (minloc (a, dim=1, mask=l, kind=4, back=.true.) .ne. 0)) stop 9
+ if (any (minloc (a, 1, l, 4, .true.) .ne. 0)) stop 10
+ if (any (minloc (a, dim=1, mask=m, kind=4, back=.true.) .ne. 0)) stop 11
+ if (any (minloc (a, 1, m, 4, .true.) .ne. 0)) stop 12
+end
diff --git a/gcc/testsuite/gfortran.dg/pr120196.f90 b/gcc/testsuite/gfortran.dg/pr120196.f90
new file mode 100644
index 0000000..368c43a
--- /dev/null
+++ b/gcc/testsuite/gfortran.dg/pr120196.f90
@@ -0,0 +1,26 @@
+! PR libfortran/120196
+! { dg-do run }
+
+program pr120196
+ character(len=:, kind=1), allocatable :: a(:), s
+ character(len=:, kind=4), allocatable :: b(:), t
+ logical, allocatable :: l(:)
+ logical :: m
+ allocate (character(len=16, kind=1) :: a(10), s)
+ allocate (l(10))
+ a(:) = ""
+ s = "*"
+ l = .true.
+ m = .true.
+ if (findloc (a, s, dim=1, back=.true.) .ne. 0) stop 1
+ if (findloc (a, s, mask=l, dim=1, back=.true.) .ne. 0) stop 2
+ if (findloc (a, s, mask=m, dim=1, back=.true.) .ne. 0) stop 3
+ deallocate (a, s)
+ allocate (character(len=16, kind=4) :: b(10), t)
+ b(:) = ""
+ t = "*"
+ if (findloc (b, t, dim=1, back=.true.) .ne. 0) stop 4
+ if (findloc (b, t, mask=l, dim=1, back=.true.) .ne. 0) stop 5
+ if (findloc (b, t, mask=m, dim=1, back=.true.) .ne. 0) stop 6
+ deallocate (b, t, l)
+end program pr120196
diff --git a/gcc/testsuite/gfortran.dg/pr120743.f90 b/gcc/testsuite/gfortran.dg/pr120743.f90
new file mode 100644
index 0000000..8682d0c
--- /dev/null
+++ b/gcc/testsuite/gfortran.dg/pr120743.f90
@@ -0,0 +1,38 @@
+! { dg-do compile }
+! PR fortran/120743 - ICE in verify_gimple_in_seq with substrings
+!
+! Testcase as reduced by Jerry DeLisle
+
+module what
+ implicit none
+ CHARACTER(LEN=:), ALLOCATABLE :: attrlist
+contains
+ SUBROUTINE get_c_attr ( attrname, attrval_c )
+ !
+ ! returns attrval_c='' if not found
+ !
+ IMPLICIT NONE
+ CHARACTER(LEN=*), INTENT(IN) :: attrname
+ CHARACTER(LEN=*), INTENT(OUT) :: attrval_c
+ !
+ CHARACTER(LEN=1) :: quote
+ INTEGER :: j0, j1
+ LOGICAL :: found
+ !
+ ! search for attribute name in attrlist: attr1="val1" attr2="val2" ...
+ !
+ attrval_c = ''
+ if ( .not. allocated(attrlist) ) return
+ if ( len_trim(attrlist) < 1 ) return
+ !
+ j0 = 1
+ do while ( j0 < len_trim(attrlist) )
+ ! locate = and first quote
+ j1 = index ( attrlist(j0:), '=' )
+ quote = attrlist(j0+j1:j0+j1)
+ ! next line: something is not right
+ if ( quote /= '"' .and. quote /= "'" ) return
+ end do
+ !
+ END SUBROUTINE get_c_attr
+end module what
diff --git a/gcc/testsuite/gfortran.dg/save_8.f90 b/gcc/testsuite/gfortran.dg/save_8.f90
new file mode 100644
index 0000000..8e9198c
--- /dev/null
+++ b/gcc/testsuite/gfortran.dg/save_8.f90
@@ -0,0 +1,13 @@
+!{ dg-do run }
+
+! Check PR120483 is fixed.
+! Contributed by Thomas Koenig <tkoenig@gcc.gnu.org>
+! and Peter Güntert <peter@guentert.com>
+
+program save_8
+ implicit none
+ character(len=:), allocatable, save :: s1
+ s1 = 'ABC'
+ if (s1(3:3) /= 'C') stop 1
+end program save_8
+
diff --git a/gcc/testsuite/gfortran.dg/save_alloc_character_1.f90 b/gcc/testsuite/gfortran.dg/save_alloc_character_1.f90
new file mode 100644
index 0000000..e26919f
--- /dev/null
+++ b/gcc/testsuite/gfortran.dg/save_alloc_character_1.f90
@@ -0,0 +1,23 @@
+! { dg-do run }
+!
+! PR fortran/120713
+! Check that the length variable of SAVEd allocatable character arrays are
+! not initialized at function entry.
+
+program p
+ implicit none
+ call s(1)
+ call s(2)
+contains
+ subroutine s(i)
+ integer, intent(in) :: i
+ character(len=:), allocatable, save :: a(:)
+ integer :: j
+ if (i == 1) then
+ allocate(a, source= [ ('x' // achar(ichar('0') + j), j=1,7) ])
+ else
+ if (len(a) /= 2) error stop 1
+ if (any(a /= ['x1','x2','x3','x4','x5','x6','x7'])) error stop 2
+ end if
+ end subroutine s
+end program p
diff --git a/gcc/testsuite/gfortran.dg/select_type_51.f90 b/gcc/testsuite/gfortran.dg/select_type_51.f90
new file mode 100644
index 0000000..6099be1
--- /dev/null
+++ b/gcc/testsuite/gfortran.dg/select_type_51.f90
@@ -0,0 +1,37 @@
+! { dg-do compile }
+!
+! Check the support by the compiler of very long symbol names in SELECT TYPE
+! and TYPE IS statements.
+!
+! Original testcase by Harald Anlauf.
+
+module m
+ implicit none
+ type t2345678901234567890123456789012345678901234567890123456789_123
+ integer :: i
+ end type t2345678901234567890123456789012345678901234567890123456789_123
+ class(*), allocatable :: a, &
+ c2345678901234567890123456789012345678901234567890123456789_123
+contains
+ subroutine check_type_is_intrinsic()
+ select type (s2345678901234567890123456789012345678901234567890123456789_123 &
+ => c2345678901234567890123456789012345678901234567890123456789_123)
+ type is (integer(kind=4))
+ print *, s2345678901234567890123456789012345678901234567890123456789_123
+ end select
+ end subroutine
+ subroutine check_type_is_derived()
+ select type (s2345678901234567890123456789012345678901234567890123456789_123 &
+ => c2345678901234567890123456789012345678901234567890123456789_123)
+ type is (t2345678901234567890123456789012345678901234567890123456789_123)
+ print *, s2345678901234567890123456789012345678901234567890123456789_123%i
+ end select
+ end subroutine
+ subroutine check_type_is_class()
+ select type (s2345678901234567890123456789012345678901234567890123456789_123 &
+ => c2345678901234567890123456789012345678901234567890123456789_123)
+ class is (t2345678901234567890123456789012345678901234567890123456789_123)
+ print *, s2345678901234567890123456789012345678901234567890123456789_123%i
+ end select
+ end subroutine
+end module m
diff --git a/gcc/testsuite/gfortran.dg/stat_3.f90 b/gcc/testsuite/gfortran.dg/stat_3.f90
new file mode 100644
index 0000000..93ec183
--- /dev/null
+++ b/gcc/testsuite/gfortran.dg/stat_3.f90
@@ -0,0 +1,46 @@
+! { dg-do compile }
+! PR fortran/82480 - checking of arguments to STAT/LSTAT/FSTAT
+
+subroutine sub1 ()
+ integer, parameter :: ik = kind(1)
+ integer(ik) :: buff12(12)
+ integer(ik) :: buff13(13)
+ integer(ik) :: unit = 10
+ integer(ik) :: ierr
+ character(len=64) :: name = "/etc/passwd"
+ ierr = stat (name, values= buff12) ! { dg-error "too small" }
+ ierr = stat (name, values= buff13)
+ ierr = lstat (name, values= buff12) ! { dg-error "too small" }
+ ierr = lstat (name, values= buff13)
+ ierr = fstat (unit, values= buff12) ! { dg-error "too small" }
+ ierr = fstat (unit, values= buff13)
+ ierr = stat (name, values=(buff13)) ! { dg-error "must be a variable" }
+ ierr = lstat (name, values=(buff13)) ! { dg-error "must be a variable" }
+ ierr = fstat (unit, values=(buff13)) ! { dg-error "must be a variable" }
+end
+
+subroutine sub2 ()
+ integer, parameter :: ik = kind(1)
+ integer(ik) :: buff12(12)
+ integer(ik), target :: buff13(13) = 0
+ integer(ik) :: unit = 10
+ integer(ik), target :: ierr = 0
+ character(len=64) :: name = "/etc/passwd"
+ integer(ik),pointer :: pbuf(:) => buff13
+ integer(ik),pointer :: perr => ierr
+ call stat (name, status=ierr, values= buff12) ! { dg-error "too small" }
+ call stat (name, status=ierr, values= buff13)
+ call lstat (name, status=ierr, values= buff12) ! { dg-error "too small" }
+ call lstat (name, status=ierr, values= buff13)
+ call fstat (unit, status=ierr, values= buff12) ! { dg-error "too small" }
+ call fstat (unit, status=ierr, values= buff13)
+ call stat (name, status=ierr, values=(buff13)) ! { dg-error "must be a variable" }
+ call lstat (name, status=ierr, values=(buff13)) ! { dg-error "must be a variable" }
+ call fstat (unit, status=ierr, values=(buff13)) ! { dg-error "must be a variable" }
+ call stat (name, status=(ierr),values=buff13) ! { dg-error "must be a variable" }
+ call lstat (name, status=(ierr),values=buff13) ! { dg-error "must be a variable" }
+ call fstat (unit, status=(ierr),values=buff13) ! { dg-error "must be a variable" }
+ call stat (name, status=perr, values= pbuf)
+ call lstat (name, status=perr, values= pbuf)
+ call fstat (unit, status=perr, values= pbuf)
+end
diff --git a/gcc/testsuite/gfortran.dg/transfer_array_subref.f90 b/gcc/testsuite/gfortran.dg/transfer_array_subref.f90
new file mode 100644
index 0000000..b480dff
--- /dev/null
+++ b/gcc/testsuite/gfortran.dg/transfer_array_subref.f90
@@ -0,0 +1,48 @@
+! { dg-do run }
+! { dg-additional-options "-O2 -fdump-tree-optimized" }
+!
+! PR fortran/102891 - passing of inquiry ref of complex array to TRANSFER
+
+program main
+ implicit none
+ integer, parameter :: dp = 8
+
+ type complex_wrap1
+ complex(dp) :: z(2)
+ end type complex_wrap1
+
+ type complex_wrap2
+ complex(dp), dimension(:), allocatable :: z
+ end type complex_wrap2
+
+ type(complex_wrap1) :: x = complex_wrap1([ (1, 2), (3, 4) ])
+ type(complex_wrap2) :: w
+
+ w%z = x%z
+
+ ! The following statements should get optimized away...
+ if (size (transfer ( x%z%re ,[1.0_dp])) /= 2) error stop 1
+ if (size (transfer ((x%z%re),[1.0_dp])) /= 2) error stop 2
+ if (size (transfer ([x%z%re],[1.0_dp])) /= 2) error stop 3
+ if (size (transfer ( x%z%im ,[1.0_dp])) /= 2) error stop 4
+ if (size (transfer ((x%z%im),[1.0_dp])) /= 2) error stop 5
+ if (size (transfer ([x%z%im],[1.0_dp])) /= 2) error stop 6
+
+ ! ... while the following may not:
+ if (any (transfer ( x%z%re ,[1.0_dp]) /= x%z%re)) stop 7
+ if (any (transfer ( x%z%im ,[1.0_dp]) /= x%z%im)) stop 8
+
+ if (size (transfer ( w%z%re ,[1.0_dp])) /= 2) stop 11
+ if (size (transfer ((w%z%re),[1.0_dp])) /= 2) stop 12
+ if (size (transfer ([w%z%re],[1.0_dp])) /= 2) stop 13
+ if (size (transfer ( w%z%im ,[1.0_dp])) /= 2) stop 14
+ if (size (transfer ((w%z%im),[1.0_dp])) /= 2) stop 15
+ if (size (transfer ([w%z%im],[1.0_dp])) /= 2) stop 16
+
+ if (any (transfer ( w%z%re ,[1.0_dp]) /= x%z%re)) stop 17
+ if (any (transfer ( w%z%im ,[1.0_dp]) /= x%z%im)) stop 18
+
+ deallocate (w%z)
+end program main
+
+! { dg-final { scan-tree-dump-not "_gfortran_error_stop_numeric" "optimized" } }