PR 36322/36463

[Dominique Dhumieres]

I overlooked the same problem for the fourth test.

> Shouldn't we have some kind of warning if this is invalid?

This problem of recursive I/O is pr30617.  Otherwise I think
it is impossible to detect the recursive I/O without analysing
the whole code (this is why the responsibility to take care is
on the user and not on the compiler). In my opinion if anyone
wants to invest some time on this problem, I think it would
be better to understand why it works on linux and hangs on
darwin then to find a way to fix darwin (I am sure it comes
from the way mutex are handled on the two platforms). As you
will see from pr30617 such a work has been strngly dismissed
(no further comment!-).

Dominique

BTW the patch fixes sevreal ICE, I got:

...
end program fptr
               1
Internal Error at (1):
gfc_get_default_type(): Bad symbol

on one of the pr35971 variants.

--- pr35971.f90	2008-06-08 20:23:11.000000000 +0200
+++ pr35971_db.f90	2008-06-29 12:31:40.000000000 +0200
@@ -34,8 +34,10 @@
    contains
 ! Procedure to store the message and get the C_FUNPTR
       function gp(message) bind(C,name='BlAh')
+         procedure(abstract_fun) make_mess
          character(kind=C_CHAR) message(*)
          type(C_FUNPTR) gp
+!         type(C_FUNPTR) aux
          integer(C_INT64_T) i
 
          i = 1
@@ -43,7 +45,8 @@
             i = i+1
          end do
          my_message = message(int(1,kind(i)):i-1)
-         gp = get_funloc(make_mess,aux)
+!         gp = get_funloc(make_mess,aux)
+         gp = aux(make_mess)
       end function gp
 
 ! Intermediate procedure to pass the function and get
@@ -81,13 +84,13 @@
    use funcs
    use other_fun
    implicit none
-   interface
+!   interface
       procedure(abstract_fun) fun
-   end interface
+!   end interface
    pointer(p,fun)
    type(C_FUNPTR) fp
 
    fp = get_proc('Hello, world'//achar(0))
    p = transfer(fp,p)
-   write(*,'(a)') fun([1,2,3])
+!   write(*,'(a)') fun([1,2,3])
 end program fptr