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/interface_60.f9070
-rw-r--r--gcc/testsuite/gfortran.dg/pr119948.f9051
-rw-r--r--gcc/testsuite/gfortran.dg/pr120049_a.f9015
-rw-r--r--gcc/testsuite/gfortran.dg/pr120049_b.f908
-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
8 files changed, 318 insertions, 9 deletions
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/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_a.f90 b/gcc/testsuite/gfortran.dg/pr120049_a.f90
new file mode 100644
index 0000000..c404a4d
--- /dev/null
+++ b/gcc/testsuite/gfortran.dg/pr120049_a.f90
@@ -0,0 +1,15 @@
+! { dg-do preprocess }
+! { dg-additional-options "-cpp" }
+!
+! 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..127db98
--- /dev/null
+++ b/gcc/testsuite/gfortran.dg/pr120049_b.f90
@@ -0,0 +1,8 @@
+! { dg-do run }
+! { dg-additional-sources pr120049_a.f90 }
+!
+! 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
generated by cgit v1.1 at 2025-05-08 18:44:19 +0000