From 554fd8c5195424bdbcabf5de30fdc183aba391bd Mon Sep 17 00:00:00 2001
From: upstream source tree <ports@midipix.org>
Date: Sun, 15 Mar 2015 20:14:05 -0400
Subject: obtained gcc-4.6.4.tar.bz2 from upstream website; verified
 gcc-4.6.4.tar.bz2.sig; imported gcc-4.6.4 source tree from verified upstream
 tarball.

downloading a git-generated archive based on the 'upstream' tag
should provide you with a source tree that is binary identical
to the one extracted from the above tarball.

if you have obtained the source via the command 'git clone',
however, do note that line-endings of files in your working
directory might differ from line-endings of the respective
files in the upstream repository.
---
 gcc/testsuite/gfortran.dg/typebound_operator_3.f03 | 125 +++++++++++++++++++++
 1 file changed, 125 insertions(+)
 create mode 100644 gcc/testsuite/gfortran.dg/typebound_operator_3.f03

(limited to 'gcc/testsuite/gfortran.dg/typebound_operator_3.f03')

diff --git a/gcc/testsuite/gfortran.dg/typebound_operator_3.f03 b/gcc/testsuite/gfortran.dg/typebound_operator_3.f03
new file mode 100644
index 000000000..51ad1d2f0
--- /dev/null
+++ b/gcc/testsuite/gfortran.dg/typebound_operator_3.f03
@@ -0,0 +1,125 @@
+! { dg-do run }
+
+! Type-bound procedures
+! Check they can actually be called and run correctly.
+! This also checks for correct module save/restore.
+
+! FIXME: Check that calls to inherited bindings work once CLASS allows that.
+
+MODULE m
+  IMPLICIT NONE
+
+  TYPE mynum
+    REAL :: num_real
+    INTEGER :: num_int
+  CONTAINS
+    PROCEDURE, PASS, PRIVATE :: add_mynum ! Check that this may be PRIVATE.
+    PROCEDURE, PASS :: add_int
+    PROCEDURE, PASS :: add_real
+    PROCEDURE, PASS :: assign_int
+    PROCEDURE, PASS :: assign_real
+    PROCEDURE, PASS(from) :: assign_to_int
+    PROCEDURE, PASS(from) :: assign_to_real
+    PROCEDURE, PASS :: get_all
+
+    GENERIC :: OPERATOR(+) => add_mynum, add_int, add_real
+    GENERIC :: OPERATOR(.GET.) => get_all
+    GENERIC :: ASSIGNMENT(=) => assign_int, assign_real, &
+                                assign_to_int, assign_to_real
+  END TYPE mynum
+
+CONTAINS
+
+  TYPE(mynum) FUNCTION add_mynum (a, b)
+    CLASS(mynum), INTENT(IN) :: a, b
+    add_mynum = mynum (a%num_real + b%num_real, a%num_int + b%num_int)
+  END FUNCTION add_mynum
+
+  TYPE(mynum) FUNCTION add_int (a, b)
+    CLASS(mynum), INTENT(IN) :: a
+    INTEGER, INTENT(IN) :: b
+    add_int = mynum (a%num_real, a%num_int + b)
+  END FUNCTION add_int
+
+  TYPE(mynum) FUNCTION add_real (a, b)
+    CLASS(mynum), INTENT(IN) :: a
+    REAL, INTENT(IN) :: b
+    add_real = mynum (a%num_real + b, a%num_int)
+  END FUNCTION add_real
+
+  REAL FUNCTION get_all (me)
+    CLASS(mynum), INTENT(IN) :: me
+    get_all = me%num_real + me%num_int
+  END FUNCTION get_all
+
+  SUBROUTINE assign_real (dest, from)
+    CLASS(mynum), INTENT(INOUT) :: dest
+    REAL, INTENT(IN) :: from
+    dest%num_real = from
+  END SUBROUTINE assign_real
+
+  SUBROUTINE assign_int (dest, from)
+    CLASS(mynum), INTENT(INOUT) :: dest
+    INTEGER, INTENT(IN) :: from
+    dest%num_int = from
+  END SUBROUTINE assign_int
+
+  SUBROUTINE assign_to_real (dest, from)
+    REAL, INTENT(OUT) :: dest
+    CLASS(mynum), INTENT(IN) :: from
+    dest = from%num_real
+  END SUBROUTINE assign_to_real
+
+  SUBROUTINE assign_to_int (dest, from)
+    INTEGER, INTENT(OUT) :: dest
+    CLASS(mynum), INTENT(IN) :: from
+    dest = from%num_int
+  END SUBROUTINE assign_to_int
+
+  ! Test it works basically within the module.
+  SUBROUTINE check_in_module ()
+    IMPLICIT NONE
+    TYPE(mynum) :: num
+
+    num = mynum (1.0, 2)
+    num = num + 7
+    IF (num%num_real /= 1.0 .OR. num%num_int /= 9) CALL abort ()
+  END SUBROUTINE check_in_module
+
+END MODULE m
+
+! Here we see it also works for use-associated operators loaded from a module.
+PROGRAM main
+  USE m, ONLY: mynum, check_in_module
+  IMPLICIT NONE
+
+  TYPE(mynum) :: num1, num2, num3
+  REAL :: real_var
+  INTEGER :: int_var
+
+  CALL check_in_module ()
+
+  num1 = mynum (1.0, 2)
+  num2 = mynum (2.0, 3)
+
+  num3 = num1 + num2
+  IF (num3%num_real /= 3.0 .OR. num3%num_int /= 5) CALL abort ()
+
+  num3 = num1 + 5
+  IF (num3%num_real /= 1.0 .OR. num3%num_int /= 7) CALL abort ()
+
+  num3 = num1 + (-100.5)
+  IF (num3%num_real /= -99.5 .OR. num3%num_int /= 2) CALL abort ()
+
+  num3 = 42
+  num3 = -1.2
+  IF (num3%num_real /= -1.2 .OR. num3%num_int /= 42) CALL abort ()
+
+  real_var = num3
+  int_var = num3
+  IF (real_var /= -1.2 .OR. int_var /= 42) CALL abort ()
+
+  IF (.GET. num1 /= 3.0) CALL abort ()
+END PROGRAM main
+
+! { dg-final { cleanup-modules "m" } }
-- 
cgit v1.2.3