Tests for non-recursive procedure passing itself as actual argument
James Van Buskirk
where a non-recursive procedure passed itself as an actual argument.
Dick Hendrickson was kind enough to find the passage in N1601.pdf,
section 12.3.1:
"The interface of a subroutine or function with a separate result
name is explicit within the suprogram that defines it."
Which puts me in agreement with Richard Maine that that should also
imply the EXTERNAL attribute, and if it can be somehow construed to
not do so, then that is simply a bug in the standard which should be
fixed.
I mentioned also that I couldn't get a valid example of a non-
recursive procedure passing itself as an actual argument working in
gfortran. I couldn't dig up the thread by searching google groups
because Google.com seems to have changed their interface in such a
way to make searching impossible. It's just too bad that a
Google has gotten control of newsgroups like this but it's something
we have to suffer with.
The point of this message is to present two attempts, one successful
and one not, for review.
C:\gfortran\clf\recursive_argument>type recursive_argument1.f90
module store_subroutine1
implicit none
abstract interface
subroutine sub
end subroutine sub
end interface
procedure(sub), pointer, private :: psub => NULL()
contains
subroutine set_sub(x)
procedure(sub) x
psub => x
end subroutine set_sub
function get_sub()
procedure(sub), pointer :: get_sub
get_sub => psub
end function get_sub
function get_sub1() result(GS)
procedure(sub), pointer :: GS
GS => psub
end function get_sub1
end module store_subroutine1
program test
use store_subroutine1
implicit none
procedure(sub), pointer :: qsub
write(*,*) 'Invoking my_sub directly:'
call my_sub
qsub => get_sub()
write(*,*) 'Invoking my_sub through stored pointer:'
call qsub
end program test
subroutine my_sub
use store_subroutine1
implicit none
write(*,*) 'In my_sub.'
call set_sub(my_sub)
end subroutine my_sub
C:\gfortran\clf\recursive_argument>gfortran
recursive_argument1.f90 -orecursive_
argument1
recursive_argument1.f90:16.43:
procedure(sub), pointer :: get_sub
1
Error: EXTERNAL attribute conflicts with FUNCTION attribute at (1)
recursive_argument1.f90:17.24:
get_sub => psub
1
Error: Function 'psub' requires an argument list at (1)
recursive_argument1.f90:22.38:
procedure(sub), pointer :: GS
1
Error: VARIABLE attribute of 'gs' conflicts with PROCEDURE attribute at (1)
recursive_argument1.f90:24.19:
GS => psub
1
Error: Function 'psub' requires an argument list at (1)
recursive_argument1.f90:21.36:
function get_sub1() result(GS)
1
Error: Result 'gs' of contained function 'get_sub1' at (1) has no IMPLICIT
type
recursive_argument1.f90:15.6:
function get_sub()
1
Error: Contained function 'get_sub' at (1) has no IMPLICIT type
recursive_argument1.f90:29.24:
use store_subroutine1
1
Fatal Error: Can't open module file 'store_subroutine1.mod' for reading at
(1):
No such file or directory
gfortran: Internal error: Aborted (program f951)
Please submit a full bug report.
See <http://gcc.gnu.org/bugs.html> for instructions.
C:\gfortran\clf\recursive_argument>type recursive_argument2.f90
module store_subroutine2
use ISO_C_BINDING, only: C_FUNPTR
implicit none
type(C_FUNPTR), private, save :: psub
contains
subroutine set_sub(x)
use ISO_C_BINDING, only: C_FUNLOC
interface
subroutine x() bind(C)
end subroutine x
end interface
psub = C_FUNLOC(x)
end subroutine set_sub
function get_sub()
type(C_FUNPTR) get_sub
get_sub = psub
end function get_sub
end module store_subroutine2
program test
use store_subroutine2
use ISO_C_BINDING, only: C_F_PROCPOINTER
implicit none
interface
subroutine my_sub() bind(C)
end subroutine my_sub
end interface
procedure(my_sub), pointer :: qsub
write(*,*) 'Invoking my_sub directly:'
call my_sub
call C_F_PROCPOINTER(get_sub(), qsub)
write(*,*) 'Invoking my_sub through stored pointer:'
call qsub
end program test
subroutine my_sub() bind(C)
use store_subroutine2
implicit none
write(*,*) 'In my_sub.'
call set_sub(my_sub)
end subroutine my_sub
C:\gfortran\clf\recursive_argument>gfortran
recursive_argument2.f90 -orecursive_
argument2
C:\gfortran\clf\recursive_argument>recursive_argument2
Invoking my_sub directly:
In my_sub.
Invoking my_sub through stored pointer:
In my_sub.
--
write(*,*) transfer((/17.392111325966148d0,6.5794487871554595D-85, &
6.0134700243160014d-154/),(/'x'/)); end
michael...@compuserve.com
Comp;iling this with Intel gives:
Warning 1 Warning: A proc-language-binding-spec is not standard
Fortran 95. C:\Users\Michael\Documents\Visual Studio 2005\Projects\temp
\temp.F90 9
Error 2 Error: Syntax error, found 'PROCEDURE' when expecting one of:
<LABEL> <END-OF-STATEMENT> ; BLOCK BLOCKDATA PROGRAM TYPE COMPLEX BYTE
CHARACTER ... C:\Users\Michael\Documents\Visual Studio 2005\Projects
\temp\temp.F90 35
Error 3 Error: Syntax error, found '::' when expecting one of: , <END-
OF-STATEMENT> ; C:\Users\Michael\Documents\Visual Studio 2005\Projects
\temp\temp.F90 35
Warning 4 Warning: A proc-language-binding-spec is not standard
Fortran 95. C:\Users\Michael\Documents\Visual Studio 2005\Projects\temp
\temp.F90 32
Warning 5 Warning: Fortran 95 does not allow this statement or
directive. C:\Users\Michael\Documents\Visual Studio 2005\Projects\temp
\temp.F90 35
Error 6 Error: This name has already been used as an external
subroutine name. [MY_SUB] C:\Users\Michael\Documents\Visual Studio
2005\Projects\temp\temp.F90 35
Error 7 Error: Confused statement; this is neither a valid I/O TYPE
stmt, nor a valid F95 derived-type-stmt, nor a valid F95 type-
declaration-stmt. C:\Users\Michael\Documents\Visual Studio
2005\Projects\temp\temp.F90 35
Error 8 Error: This name does not have a type, and must have an
explicit type. [POINTER] C:\Users\Michael\Documents\Visual Studio
2005\Projects\temp\temp.F90 35
Error 9 Error: This name does not have a type, and must have an
explicit type. [QSUB] C:\Users\Michael\Documents\Visual Studio
2005\Projects\temp\temp.F90 35
Warning 10 Warning: A proc-language-binding-spec is not standard
Fortran 95. C:\Users\Michael\Documents\Visual Studio 2005\Projects\temp
\temp.F90 46
Error 11 Error: A subroutine or function is calling itself
recursively. [MY_SUB] C:\Users\Michael\Documents\Visual Studio
2005\Projects\temp\temp.F90 52
Error 12 Compilation Aborted (code 1) C:\Users\Michael\Documents
\Visual Studio 2005\Projects\temp\temp.F90 1
Regarfds,
Mike Metcalf
James Van Buskirk
news:a6fa31c2-851b-4baf...@y18g2000yqn.googlegroups.com...
> Comp;iling this with Intel gives:
> Warning 1 Warning: A proc-language-binding-spec is not standard
> Fortran 95. C:\Users\Michael\Documents\Visual Studio 2005\Projects\temp
> \temp.F90 9
> Error 2 Error: Syntax error, found 'PROCEDURE' when expecting one of:
> <LABEL> <END-OF-STATEMENT> ; BLOCK BLOCKDATA PROGRAM TYPE COMPLEX BYTE
> CHARACTER ... C:\Users\Michael\Documents\Visual Studio 2005\Projects
> \temp\temp.F90 35
...
> Error 11 Error: A subroutine or function is calling itself
> recursively. [MY_SUB] C:\Users\Michael\Documents\Visual Studio
> 2005\Projects\temp\temp.F90 52
Could you give the command line used to compile and ifort's banner?
A couple of things that I notice are that you are getting f95
standards warnings. This code is way over on the Dark Side, so
only /stand:f03 or no standard specified is appropriate. Also
procedure pointers are IIRC a relatively recent addition to ifort
so the version (as would be printed out in the banner) may be
significant.
Mmmf... I had intended to download yesterday's snapshot of gfrotran
before running my tests but forgot. Just did so:
C:\gfortran\clf\recursive_argument>gfortran -v
Built by Equation Solution (http://www.Equation.com).
Using built-in specs.
Target: x86_64-pc-mingw32
Configured with:
../gcc-4.4-20081121-mingw/configure --host=x86_64-pc-mingw32 --
build=x86_64-unknown-linux-gnu --target=x86_64-pc-mingw32 --prefix=/home/gfortra
n/gcc-home/binary/mingw32/native/x86_64/gcc/4.4-20081121 --with-gmp=/home/gfortr
an/gcc-home/binary/mingw32/native/x86_64/gmp --with-mpfr=/home/gfortran/gcc-home
/binary/mingw32/native/x86_64/mpfr --with-sysroot=/home/gfortran/gcc-home/binary
/mingw32/cross/x86_64/gcc/4.4-20081121 --with-gcc --with-gnu-ld --with-gnu-as
--
disable-shared --disable-nls --disable-tls --enable-libgomp --enable-languages=c
,fortran --enable-threads=win32 --disable-win32-registry
Thread model: win32
gcc version 4.4.0 20081121 (experimental) (GCC)
With same results as before.
I am more curious about recursive_argument1.f90 because I can't get
gfortran to like it, so I don't have the opportunity to test that
example for bugs.
Tobias Burnus
On Nov 22, 6:48 pm, "James Van Buskirk" <not_va...@comcast.net> wrote:
> function get_sub1() result(GS)
> procedure(sub), pointer :: GS
That won't work in gfortran 4.4.0 as
"Procedure Pointers (but not yet as component in derived types and as
function results) are now supported."
See: http://gcc.gnu.org/gcc-4.4/changes.html
As for GCC 4.4.0 only regression plus documentation fixes (and
selected rejects-valid/wrong-code bugs) are allowed, you need to wait
for 4.5 until it will get supported. Presumably, GCC 4.4.0 is going to
be release in January (+/- a month).
Work around: Use "subroutine get_subl(GS)"; procedure pointers as
actual/dummy argument are supported.
Tobias
PS: Regarding your RESHAPE example: That is a known problem - still
unfixed but a patch exists (PR 38184). I created a bug report for
supporting SUM() in initialization expressions, but that is also a GCC
4.5 item.
James Van Buskirk
news:4d995e0f-5415-475b...@u14g2000yqg.googlegroups.com...
> On Nov 22, 6:48 pm, "James Van Buskirk" <not_va...@comcast.net> wrote:
> > function get_sub1() result(GS)
> > procedure(sub), pointer :: GS
> That won't work in gfortran 4.4.0 as
> "Procedure Pointers (but not yet as component in derived types and as
> function results) are now supported."
> See: http://gcc.gnu.org/gcc-4.4/changes.html
> As for GCC 4.4.0 only regression plus documentation fixes (and
> selected rejects-valid/wrong-code bugs) are allowed, you need to wait
> for 4.5 until it will get supported. Presumably, GCC 4.4.0 is going to
> be release in January (+/- a month).
> Work around: Use "subroutine get_subl(GS)"; procedure pointers as
> actual/dummy argument are supported.
Thanks for the tip. Here is a reworked example:
C:\gfortran\clf\recursive_argument>type recursive_argument3.f90
module store_subroutine3
implicit none
abstract interface
subroutine sub
end subroutine sub
end interface
procedure(sub), pointer, private :: psub => NULL()
contains
subroutine set_sub(x)
procedure(sub) x
psub => x
end subroutine set_sub
subroutine get_sub(GS)
procedure(sub), pointer :: GS
GS => psub
end subroutine get_sub
end module store_subroutine3
program test
use store_subroutine3
implicit none
procedure(sub), pointer :: qsub
write(*,*) 'Invoking my_sub directly:'
call my_sub
call get_sub(qsub)
write(*,*) 'Invoking my_sub through stored pointer:'
call qsub
end program test
subroutine my_sub
use store_subroutine3
implicit none
write(*,*) 'In my_sub.'
call set_sub(my_sub)
end subroutine my_sub
C:\gfortran\clf\recursive_argument>gfortran
recursive_argument3.f90 -orecursive_
argument3
C:\DOCUME~1\ADMINI~1\LOCALS~1\Temp/ccOPomc8.o:recursive_argument3.f90:(.text+0xb
): undefined reference to `psub.1528'
C:\DOCUME~1\ADMINI~1\LOCALS~1\Temp/ccOPomc8.o:recursive_argument3.f90:(.text+0x2
7): undefined reference to `psub.1528'
collect2: ld returned 1 exit status
So it still doesn't work. Is it me or gfortran?
> PS: Regarding your RESHAPE example: That is a known problem - still
> unfixed but a patch exists (PR 38184). I created a bug report for
> supporting SUM() in initialization expressions, but that is also a GCC
> 4.5 item.
Ok and thanks. I have been following some of the PRs and that's why I
was so keen on finding time to create these examples because I wasn't
sure that it is as clear to you as it is to me that it should be fine
for a non-recursive procedure to pass itself as an actual argument.
After all, the effect of this action is just to make its address
available to the callee and this address was already available
since the callee could have invoked the external caller by name
in the first place. Since there's no way to detect this in general
(except in cases such as a callee internal to the caller as noted
in bugzilla) there is no reason to prevent even a non-recursive
external procedure from passing itself as an actual argument.
James Van Buskirk
news:4d995e0f-5415-475b...@u14g2000yqg.googlegroups.com...
> PS: Regarding your RESHAPE example: That is a known problem - still
> unfixed but a patch exists (PR 38184). I created a bug report for
> supporting SUM() in initialization expressions, but that is also a GCC
> 4.5 item.
Oh yes, there is another issue regarding SUM and initialization
expressions.
C:\gfortran\clf\standard_reshape>type standard_reshape.f90
module funcs
implicit none
contains
function is_f2003()
logical is_f2003
logical dud
is_f2003 = aux(1)
end function is_f2003
recursive function aux(depth) result(result)
logical result
integer depth
! character(sum((/1,2/))) test_val
! character(sum((/1,2/))), save :: test_val
! character(3), save :: test_val
character(3) :: test_val
logical dud
! save
test_val = 'abc'
if(depth > 0) then
dud = aux(depth-1)
end if
!write(*,*) 'xyz'
result = test_val == 'xyz'
test_val = 'xyz'
end function aux
end module funcs
program standard_reshape
use funcs
implicit none
write(*,'(a)') trim(merge('Version is f2003', &
'Version is f95 ',is_f2003()))
end program standard_reshape
C:\gfortran\clf\standard_reshape>gfortran
standard_reshape.f90 -ostandard_reshap
e
C:\gfortran\clf\standard_reshape>standard_reshape
Version is f95
C:\gfortran\clf\standard_reshape>type standard_reshape.f90
module funcs
implicit none
contains
function is_f2003()
logical is_f2003
logical dud
is_f2003 = aux(1)
end function is_f2003
recursive function aux(depth) result(result)
logical result
integer depth
! character(sum((/1,2/))) test_val
! character(sum((/1,2/))), save :: test_val
character(3), save :: test_val
! character(3) :: test_val
logical dud
! save
test_val = 'abc'
if(depth > 0) then
dud = aux(depth-1)
end if
!write(*,*) 'xyz'
result = test_val == 'xyz'
test_val = 'xyz'
end function aux
end module funcs
program standard_reshape
use funcs
implicit none
write(*,'(a)') trim(merge('Version is f2003', &
'Version is f95 ',is_f2003()))
end program standard_reshape
C:\gfortran\clf\standard_reshape>gfortran
standard_reshape.f90 -ostandard_reshap
e
C:\gfortran\clf\standard_reshape>standard_reshape
Version is f2003
As you can see, if test_val has the SAVE attribute, is_f2003()
returns .TRUE., if not it returns .FALSE.
First off, the program hangs if that write statement is active:
C:\gfortran\clf\standard_reshape>type standard_reshape.f90
module funcs
implicit none
contains
function is_f2003()
logical is_f2003
logical dud
is_f2003 = aux(1)
end function is_f2003
recursive function aux(depth) result(result)
logical result
integer depth
! character(sum((/1,2/))) test_val
! character(sum((/1,2/))), save :: test_val
character(3), save :: test_val
! character(3) :: test_val
logical dud
! save
test_val = 'abc'
if(depth > 0) then
dud = aux(depth-1)
end if
write(*,*) 'xyz'
result = test_val == 'xyz'
test_val = 'xyz'
end function aux
end module funcs
program standard_reshape
use funcs
implicit none
write(*,'(a)') trim(merge('Version is f2003', &
'Version is f95 ',is_f2003()))
end program standard_reshape
C:\gfortran\clf\standard_reshape>gfortran
standard_reshape.f90 -ostandard_reshap
e
C:\gfortran\clf\standard_reshape>standard_reshape
^C
Secondly, if LEN(test_val) is given via the SUM intrinsic it
should not be legal in f95 to give it the SAVE attribute. gfortran
permits it, but then ignores the SAVE attribute!
C:\gfortran\clf\standard_reshape>type standard_reshape.f90
module funcs
implicit none
contains
function is_f2003()
logical is_f2003
logical dud
is_f2003 = aux(1)
end function is_f2003
recursive function aux(depth) result(result)
logical result
integer depth
! character(sum((/1,2/))) test_val
character(sum((/1,2/))), save :: test_val
! character(3), save :: test_val
! character(3) :: test_val
logical dud
! save
test_val = 'abc'
if(depth > 0) then
dud = aux(depth-1)
end if
!write(*,*) 'xyz'
result = test_val == 'xyz'
test_val = 'xyz'
end function aux
end module funcs
program standard_reshape
use funcs
implicit none
write(*,'(a)') trim(merge('Version is f2003', &
'Version is f95 ',is_f2003()))
end program standard_reshape
C:\gfortran\clf\standard_reshape>gfortran -std=f95
standard_reshape.f90 -ostanda
rd_reshape
C:\gfortran\clf\standard_reshape>standard_reshape
Version is f95
Lastly, with the empty SAVE statement we should be able to
see the difference between f95 and f2003. It should compile
with -std=f95 and print out 'Version is f95', and with f2003
it should either fail to compile (because the SUM intrinsic
is not yet implemented in initialization expressions) or
compile and print out 'Version is f2003'.
C:\gfortran\clf\standard_reshape>type standard_reshape.f90
module funcs
implicit none
contains
function is_f2003()
logical is_f2003
logical dud
is_f2003 = aux(1)
end function is_f2003
recursive function aux(depth) result(result)
logical result
integer depth
character(sum((/1,2/))) test_val
! character(sum((/1,2/))), save :: test_val
! character(3), save :: test_val
! character(3) :: test_val
logical dud
save
test_val = 'abc'
if(depth > 0) then
dud = aux(depth-1)
end if
!write(*,*) 'xyz'
result = test_val == 'xyz'
test_val = 'xyz'
end function aux
end module funcs
program standard_reshape
use funcs
implicit none
write(*,'(a)') trim(merge('Version is f2003', &
'Version is f95 ',is_f2003()))
end program standard_reshape
C:\gfortran\clf\standard_reshape>gfortran -std=f95
standard_reshape.f90 -ostanda
rd_reshape
standard_reshape.f90:11.50:
recursive function aux(depth) result(result)
1
Error: RESULT attribute conflicts with SAVE attribute in 'result' at (1)
standard_reshape.f90:32.12:
use funcs
1
Fatal Error: Can't open module file 'funcs.mod' for reading at (1): No such
file
or directory
gfortran: Internal error: Aborted (program f951)
Please submit a full bug report.
See <http://gcc.gnu.org/bugs.html> for instructions.
C:\gfortran\clf\standard_reshape>gfortran -std=f2003
standard_reshape.f90 -ostan
dard_reshape
standard_reshape.f90:11.50:
recursive function aux(depth) result(result)
1
Error: RESULT attribute conflicts with SAVE attribute in 'result' at (1)
standard_reshape.f90:32.12:
use funcs
1
Fatal Error: Can't open module file 'funcs.mod' for reading at (1): No such
file
or directory
gfortran: Internal error: Aborted (program f951)
Please submit a full bug report.
See <http://gcc.gnu.org/bugs.html> for instructions.
Empty SAVE is to be applied only where it is not permitted, but gfortran
is trying to apply it to a function result.
So I see lots of room for improvement in this example.
Herman D. Knoble
Latest version of g95 aborts on the first example below. And works on the second example,
the results agreeing with your posted results.
Skip Knoble
On Sat, 22 Nov 2008 10:48:33 -0700, "James Van Buskirk" <not_...@comcast.net> wrote:
-|A while back there was a thread where I tried to create some examples
-|where a non-recursive procedure passed itself as an actual argument.
-|Dick Hendrickson was kind enough to find the passage in N1601.pdf,
-|section 12.3.1:
-|
-|"The interface of a subroutine or function with a separate result
-|name is explicit within the suprogram that defines it."
-|
-|Which puts me in agreement with Richard Maine that that should also
-|imply the EXTERNAL attribute, and if it can be somehow construed to
-|not do so, then that is simply a bug in the standard which should be
-|fixed.
-|
-|I mentioned also that I couldn't get a valid example of a non-
-|recursive procedure passing itself as an actual argument working in
-|gfortran. I couldn't dig up the thread by searching google groups
-|because Google.com seems to have changed their interface in such a
-|way to make searching impossible. It's just too bad that a
-|Google has gotten control of newsgroups like this but it's something
-|we have to suffer with.
-|
-|The point of this message is to present two attempts, one successful
-|and one not, for review.
-|
-|C:\gfortran\clf\recursive_argument>type recursive_argument1.f90
-|module store_subroutine1
-| implicit none
-| abstract interface
-| subroutine sub
-| end subroutine sub
-| end interface
-| procedure(sub), pointer, private :: psub => NULL()
-| contains
-| subroutine set_sub(x)
-| procedure(sub) x
-|
-| psub => x
-| end subroutine set_sub
-|
-| function get_sub()
-| procedure(sub), pointer :: get_sub
-| get_sub => psub
-|
-| end function get_sub
-|
-| function get_sub1() result(GS)
-| procedure(sub), pointer :: GS
-|
-| GS => psub
-| end function get_sub1
-|end module store_subroutine1
-|
-|program test
-| use store_subroutine1
-| implicit none
-| procedure(sub), pointer :: qsub
-|
-| write(*,*) 'Invoking my_sub directly:'
-| call my_sub
-| qsub => get_sub()
-| write(*,*) 'Invoking my_sub through stored pointer:'
-| call qsub
-|end program test
-|
-|subroutine my_sub
-| use store_subroutine1
-| implicit none
-|
-| write(*,*) 'In my_sub.'
-| call set_sub(my_sub)
-|end subroutine my_sub
-|
-|C:\gfortran\clf\recursive_argument>gfortran
-|recursive_argument1.f90 -orecursive_
-|argument1
-|recursive_argument1.f90:16.43:
-|
-| procedure(sub), pointer :: get_sub
-| 1
-|Error: EXTERNAL attribute conflicts with FUNCTION attribute at (1)
-|recursive_argument1.f90:17.24:
-|
-| get_sub => psub
-| 1
-|Error: Function 'psub' requires an argument list at (1)
-|recursive_argument1.f90:22.38:
-|
-| procedure(sub), pointer :: GS
-| 1
-|Error: VARIABLE attribute of 'gs' conflicts with PROCEDURE attribute at (1)
-|recursive_argument1.f90:24.19:
-|
-| GS => psub
-| 1
-|Error: Function 'psub' requires an argument list at (1)
-|recursive_argument1.f90:21.36:
-|
-| function get_sub1() result(GS)
-| 1
-|Error: Result 'gs' of contained function 'get_sub1' at (1) has no IMPLICIT
-|type
-|recursive_argument1.f90:15.6:
-|
-| function get_sub()
-| 1
-|Error: Contained function 'get_sub' at (1) has no IMPLICIT type
-|recursive_argument1.f90:29.24:
-|
-| use store_subroutine1
-| 1
-|Fatal Error: Can't open module file 'store_subroutine1.mod' for reading at
-|(1):
-|No such file or directory
-|gfortran: Internal error: Aborted (program f951)
-|Please submit a full bug report.
-|See <http://gcc.gnu.org/bugs.html> for instructions.
-|
-|C:\gfortran\clf\recursive_argument>type recursive_argument2.f90
-|module store_subroutine2
-| use ISO_C_BINDING, only: C_FUNPTR
-| implicit none
-| type(C_FUNPTR), private, save :: psub
-| contains
-| subroutine set_sub(x)
-| use ISO_C_BINDING, only: C_FUNLOC
-| interface
-| subroutine x() bind(C)
-| end subroutine x
-| end interface
-|
-| psub = C_FUNLOC(x)
-| end subroutine set_sub
-|
-| function get_sub()
-| type(C_FUNPTR) get_sub
-|
-| get_sub = psub
-| end function get_sub
-|end module store_subroutine2
-|
-|program test
-| use store_subroutine2
-| use ISO_C_BINDING, only: C_F_PROCPOINTER
-| implicit none
-| interface
-| subroutine my_sub() bind(C)
-| end subroutine my_sub
-| end interface
-| procedure(my_sub), pointer :: qsub
-|
-| write(*,*) 'Invoking my_sub directly:'
-| call my_sub
-| call C_F_PROCPOINTER(get_sub(), qsub)
-| write(*,*) 'Invoking my_sub through stored pointer:'
-| call qsub
-|end program test
-|
-|subroutine my_sub() bind(C)
-| use store_subroutine2
-| implicit none
-|
-| write(*,*) 'In my_sub.'
-| call set_sub(my_sub)
-|end subroutine my_sub
-|
-|C:\gfortran\clf\recursive_argument>gfortran
-|recursive_argument2.f90 -orecursive_
-|argument2
-|
-|C:\gfortran\clf\recursive_argument>recursive_argument2
-| Invoking my_sub directly:
-| In my_sub.
-| Invoking my_sub through stored pointer:
-| In my_sub.
Steve Lionel
>
>Comp;iling this with Intel gives:
>
>Warning 1 Warning: A proc-language-binding-spec is not standard
>Fortran 95. C:\Users\Michael\Documents\Visual Studio 2005\Projects\temp
You're using 10,1 or an older version which does not support PROCEDURE.
Compiling with 11.0.066 gives:
recursive_argument1.f90(10): error #8169: The specified interface is not
declared. [SUB]
procedure(sub) x
-------------------^
recursive_argument1.f90(16): error #6406: Conflicting attributes or multiple
declaration of name. [GET_SUB]
procedure(sub), pointer :: get_sub
------------------------------------^
recursive_argument1.f90(21): error #6831: The result-name in the construct
'RESULT(result-name)' may only be used once; it incorrectly appears elsewhere
in specification statements. [GS]
function get_sub1() result(GS)
---------------------------------^
recursive_argument1.f90(22): error #8169: The specified interface is not
declared. [SUB]
procedure(sub), pointer :: GS
-------------------^
recursive_argument1.f90(17): error #6796: The variable must have the TARGET
attribute or be a subobject of an object with the TARGET attribute, or it must
have
the POINTER attribute. [PSUB]
get_sub => psub
--------------------^
Plus additional errors that cascade from this. This doesn't look right to me
either. We'll look into this.
--
Steve Lionel
Developer Products Division
Intel Corporation
Nashua, NH
For email address, replace "invalid" with "com"
User communities for Intel Software Development Products
http://software.intel.com/en-us/forums/
Intel Fortran Support
http://support.intel.com/support/performancetools/fortran
My Fortran blog
http://www.intel.com/software/drfortran
Jan Vorbrüggen
> either. We'll look into this.
More and more, I am of the opinion that the Fortran compiler developers
should hire JVB as a consultant for torture-testing their software
....err, excuse me, devising tests for the dark corners of the standard.
If you pool your efforts, it will even be cost-effective 8-).
Jan
James Van Buskirk
news:p1oli4li8n4qikft2...@4ax.com...
> Plus additional errors that cascade from this. This doesn't look right to
> me
> either. We'll look into this.
I have been experimenting with cray pointers instead of procedure
pointers:
C:\gfortran\clf\recursive_argument>type recursive_argument5.f90
module store_subroutine5
implicit none
integer, parameter :: C_INTPTR_T = INT_PTR_KIND()
integer(C_INTPTR_T), private :: psub
contains
subroutine set_sub(x)
interface
subroutine x
end subroutine x
end interface
psub = LOC(x)
end subroutine set_sub
function get_sub()
interface
subroutine sub
end subroutine sub
end interface
pointer (get_sub, sub)
get_sub = psub
end function get_sub
function get_sub1() result(GS)
interface
subroutine sub
end subroutine sub
end interface
pointer (GS, sub)
GS = psub
end function get_sub1
end module store_subroutine5
program test
use store_subroutine5
implicit none
interface
subroutine sub
end subroutine sub
end interface
pointer (qsub, sub)
write(*,*) 'Invoking my_sub directly:'
call my_sub
qsub = get_sub1()
write(*,*) 'Invoking my_sub through stored pointer:'
call sub
end program test
!recursive subroutine my_sub
subroutine my_sub
use store_subroutine5
implicit none
write(*,*) 'In my_sub.'
call set_sub(my_sub)
end subroutine my_sub
C:\gfortran\clf\recursive_argument>ifort recursive_argument5.f90
Intel(R) Fortran Compiler for Intel(R) EM64T-based applications, Version 9.1
Build 20061104
Copyright (C) 1985-2006 Intel Corporation. All rights reserved.
recursive_argument5.f90(21) : Error: Conflicting attributes or multiple
declarat
ion of name. [GET_SUB]
pointer (get_sub, sub)
------------------^
recursive_argument5.f90(59) : Error: A subroutine or function is calling
itself
recursively. [MY_SUB]
call set_sub(my_sub)
----------------^
compilation aborted for recursive_argument5.f90 (code 1)
The second error above was the motivation for this set of tests in
the first place: for a procedure to pass itself as an actual
argument is not the same as invoking itself. What I envision is that
a procedure is asked to register itself after which it may be invoked
after it returns to its caller. Doesn't seem too outlandish for a
Windows procedure to have an interface like this. I think the error
message is given in error and that it should be OK.
The first error above is documented for ifort:
"o A pointer cannot be a function return value."
Now, this seems to me to be a silly restriction, and we could work
around it by returning an INTEGER(INT_PTR_KIND()) but I have a much
more awesome workaround.
After a few edits we have the workaround in place and have declared
out subroutine to be recursive so that ifort won't complain:
C:\gfortran\clf\recursive_argument>type recursive_argument5.f90
module store_subroutine5
implicit none
integer, parameter :: C_INTPTR_T = INT_PTR_KIND()
integer(C_INTPTR_T), private :: psub
contains
subroutine set_sub(x)
interface
subroutine x
end subroutine x
end interface
psub = LOC(x)
end subroutine set_sub
! function get_sub()
! interface
! subroutine sub
! end subroutine sub
! end interface
! pointer (get_sub, sub)
! get_sub = psub
!
! end function get_sub
function get_sub1() result(GS)
interface
subroutine sub
end subroutine sub
end interface
pointer (GS, sub)
GS = psub
end function get_sub1
end module store_subroutine5
program test
use store_subroutine5
implicit none
interface
subroutine sub
end subroutine sub
end interface
pointer (qsub, sub)
write(*,*) 'Invoking my_sub directly:'
call my_sub
qsub = get_sub1()
write(*,*) 'Invoking my_sub through stored pointer:'
call sub
end program test
recursive subroutine my_sub
!subroutine my_sub
use store_subroutine5
implicit none
write(*,*) 'In my_sub.'
call set_sub(my_sub)
end subroutine my_sub
C:\gfortran\clf\recursive_argument>ifort recursive_argument5.f90
Intel(R) Fortran Compiler for Intel(R) EM64T-based applications, Version 9.1
Build 20061104
Copyright (C) 1985-2006 Intel Corporation. All rights reserved.
recursive_argument5.f90(59) : Error: The classification of the associated
actual
procedure differs from the classification of the dummy procedure; i.e., one
is
subroutine and one is function (12.2). [MY_SUB]
call set_sub(my_sub)
----------------^
compilation aborted for recursive_argument5.f90 (code 1)
But we are now blocked by a new problem: ifort won't tell us which of
the two procedures (actual or dummy) is a subroutine and which is a
function, so we can't move forward to fix the offender.
Now let's see what happens with gfortran and cray pointers:
C:\gfortran\clf\recursive_argument>type recursive_argument4.f90
module store_subroutine4
use ISO_C_BINDING, only: C_INTPTR_T
implicit none
integer(C_INTPTR_T), private :: psub
contains
subroutine set_sub(x)
interface
subroutine x
end subroutine x
end interface
psub = LOC(x)
end subroutine set_sub
function get_sub()
interface
subroutine sub
end subroutine sub
end interface
pointer (get_sub, sub)
get_sub = psub
end function get_sub
function get_sub1() result(GS)
interface
subroutine sub
end subroutine sub
end interface
pointer (GS, sub)
GS = psub
end function get_sub1
end module store_subroutine4
program test
use store_subroutine4
implicit none
interface
subroutine sub
end subroutine sub
end interface
pointer (qsub, sub)
write(*,*) 'Invoking my_sub directly:'
call my_sub
qsub = get_sub1()
write(*,*) 'Invoking my_sub through stored pointer:'
call sub
end program test
subroutine my_sub
use store_subroutine4
implicit none
write(*,*) 'In my_sub.'
call set_sub(my_sub)
end subroutine my_sub
C:\gfortran\clf\recursive_argument>gfortran -fcray-pointer
recursive_argument4.f
90 -orecursive_argument4
recursive_argument4.f90:21.18:
pointer (get_sub, sub)
1
Error: CRAY POINTER attribute conflicts with FUNCTION attribute at (1)
recursive_argument4.f90:16.6:
function get_sub()
1
Error: Function result 'get_sub' at (1) has no IMPLICIT type
recursive_argument4.f90:38.24:
use store_subroutine4
1
Fatal Error: Can't open module file 'store_subroutine4.mod' for reading at
(1):
No such file or directory
gfortran: Internal error: Aborted (program f951)
Please submit a full bug report.
See <http://gcc.gnu.org/bugs.html> for instructions.
We can see that gfortran doesn't like function results to be cray
pointers either, although I can't find this in the gfortran manual.
We can work around that problem just like we did with ifort, though:
C:\gfortran\clf\recursive_argument>type recursive_argument4.f90
module store_subroutine4
use ISO_C_BINDING, only: C_INTPTR_T
implicit none
integer(C_INTPTR_T), private :: psub
contains
subroutine set_sub(x)
interface
subroutine x
end subroutine x
end interface
psub = LOC(x)
end subroutine set_sub
! function get_sub()
! interface
! subroutine sub
! end subroutine sub
! end interface
! pointer (get_sub, sub)
! get_sub = psub
!
! end function get_sub
function get_sub1() result(GS)
interface
subroutine sub
end subroutine sub
end interface
pointer (GS, sub)
GS = psub
end function get_sub1
end module store_subroutine4
program test
use store_subroutine4
implicit none
interface
subroutine sub
end subroutine sub
end interface
pointer (qsub, sub)
write(*,*) 'Invoking my_sub directly:'
call my_sub
qsub = get_sub1()
write(*,*) 'Invoking my_sub through stored pointer:'
call sub
end program test
subroutine my_sub
use store_subroutine4
implicit none
write(*,*) 'In my_sub.'
call set_sub(my_sub)
end subroutine my_sub
C:\gfortran\clf\recursive_argument>gfortran -fcray-pointer
recursive_argument4.f
90 -orecursive_argument4
C:\gfortran\clf\recursive_argument>recursive_argument4
Invoking my_sub directly:
In my_sub.
Invoking my_sub through stored pointer:
In my_sub.
Success!