Mercurial > hg > CbC > CbC_gcc
comparison gcc/testsuite/gfortran.dg/proc_ptr_19.f90 @ 111:04ced10e8804
gcc 7
| author | kono |
|---|---|
| date | Fri, 27 Oct 2017 22:46:09 +0900 |
| parents | |
| children | 84e7813d76e9 |
comparison
equal
deleted
inserted
replaced
| 68:561a7518be6b | 111:04ced10e8804 |
|---|---|
| 1 ! { dg-do run } | |
| 2 ! | |
| 3 ! PR 40176: Fortran 2003: Procedure pointers with array return value | |
| 4 ! | |
| 5 ! This example tests for a bug in procedure pointer assignments, | |
| 6 ! where the rhs is a dummy. | |
| 7 ! | |
| 8 ! Original test case by Barron Bichon <barron.bichon@swri.org> | |
| 9 ! Modified by Janus Weil <janus@gcc.gnu.org> | |
| 10 | |
| 11 PROGRAM test_prog | |
| 12 | |
| 13 PROCEDURE(add), POINTER :: forig, fset | |
| 14 | |
| 15 forig => add | |
| 16 | |
| 17 CALL set_ptr(forig,fset) | |
| 18 | |
| 19 if (forig(1,2) /= fset(1,2)) call abort() | |
| 20 | |
| 21 CONTAINS | |
| 22 | |
| 23 SUBROUTINE set_ptr(f1,f2) | |
| 24 PROCEDURE(add), POINTER :: f1, f2 | |
| 25 f2 => f1 | |
| 26 END SUBROUTINE set_ptr | |
| 27 | |
| 28 FUNCTION add(a,b) | |
| 29 INTEGER :: a,b,add | |
| 30 add = a+b | |
| 31 | |
| 32 END FUNCTION add | |
| 33 | |
| 34 END PROGRAM test_prog | |
| 35 |