Dear All,
This regression arose from my patch for PR79382. I have removed the
compile time error but have prevented the ICE by ensuring that the
dtio generic symbol has flavor FL_PROCEDURE. dtio_23.f90 has been
modified to incorporate the test for this PR and not to check for the
now absent error message. At the moment, I do not see how to recover
the error. However, with this patch applied, no incorrect code is
generated and the spurious error is suppressed.
Bootstraps and regtests on FC23/x86_64 - OK for trunk?
Paul
2017-03-25 Paul Thomas <pa...@gcc.gnu.org>
PR fortran/80156
PR fortran/79382
* decl.c (access_attr_decl): Remove the error for an absent
generic DTIO interface and ensure that symbol has the flavor
FL_PROCEDURE.
2017-03-25 Paul Thomas <pa...@gcc.gnu.org>
PR fortran/80156
PR fortran/79382
* gfortran.dg/dtio_23.f90 : Remove the dg-error and add the
testcase for PR80156. Add a main programme that tests that
the typebound generic is accessible.
--
"If you can't explain it simply, you don't understand it well enough"
- Albert Einstein
Index: gcc/fortran/decl.c
===================================================================
*** gcc/fortran/decl.c (revision 246255)
--- gcc/fortran/decl.c (working copy)
*************** access_attr_decl (gfc_statement st)
*** 7569,7591 ****
case INTERFACE_GENERIC:
case INTERFACE_DTIO:
- if (type == INTERFACE_DTIO
- && gfc_current_ns->proc_name
- && gfc_current_ns->proc_name->attr.flavor == FL_MODULE)
- {
- gfc_find_symbol (name, gfc_current_ns, 0, &sym);
- if (sym == NULL)
- {
- gfc_error ("The GENERIC DTIO INTERFACE at %C is not "
- "present in the MODULE '%s'",
- gfc_current_ns->proc_name->name);
- return MATCH_ERROR;
- }
- }
-
if (gfc_get_symbol (name, NULL, &sym))
goto done;
if (!gfc_add_access (&sym->attr,
(st == ST_PUBLIC)
? ACCESS_PUBLIC : ACCESS_PRIVATE,
--- 7569,7583 ----
case INTERFACE_GENERIC:
case INTERFACE_DTIO:
if (gfc_get_symbol (name, NULL, &sym))
goto done;
+ if (type == INTERFACE_DTIO
+ && gfc_current_ns->proc_name
+ && gfc_current_ns->proc_name->attr.flavor == FL_MODULE
+ && sym->attr.flavor == FL_UNKNOWN)
+ sym->attr.flavor = FL_PROCEDURE;
+
if (!gfc_add_access (&sym->attr,
(st == ST_PUBLIC)
? ACCESS_PUBLIC : ACCESS_PRIVATE,
Index: gcc/testsuite/gfortran.dg/dtio_23.f90
===================================================================
*** gcc/testsuite/gfortran.dg/dtio_23.f90 (revision 246255)
--- gcc/testsuite/gfortran.dg/dtio_23.f90 (working copy)
***************
*** 1,8 ****
! { dg-do compile }
!
! ! Test fix for the original in PR79832.
!
! Contributed by Walt Brainerd <walt.brain...@gmail.com>
!
module dollar_mod
--- 1,9 ----
! { dg-do compile }
!
! ! Test fix for the original in PR793822 and for PR80156.
!
! Contributed by Walt Brainerd <walt.brain...@gmail.com>
+ ! and (PR80156) <pedsx...@gmx.net>
!
module dollar_mod
*************** module dollar_mod
*** 16,22 ****
generic :: write(formatted) => Write_dollar
end type dollar_type
! PRIVATE :: write (formatted) ! { dg-error "is not present" }
contains
--- 17,23 ----
generic :: write(formatted) => Write_dollar
end type dollar_type
! PRIVATE :: write (formatted) ! This used to ICE
contains
*************** subroutine Write_dollar &
*** 35,37 ****
--- 36,76 ----
end subroutine Write_dollar
end module dollar_mod
+
+ module pr80156
+
+ implicit none
+ private
+
+ type, public :: String
+ character(len=:), allocatable :: raw
+ end type
+
+ public :: write(unformatted) ! Gave an error due to the first fix for
PR79382.
+ interface write(unformatted)
+ module procedure writeUnformatted
+ end interface
+
+ contains
+
+ subroutine writeUnformatted(self, unit, iostat, iomsg)
+ class(String) , intent(in) :: self
+ integer , intent(in) :: unit
+ integer , intent(out) :: iostat
+ character(len=*), intent(inout) :: iomsg
+
+ if (allocated(self%raw)) then
+ write (unit, iostat=iostat, iomsg=iomsg) self%raw
+ else
+ write (unit, iostat=iostat, iomsg=iomsg) ''
+ endif
+
+ end subroutine
+
+ end module
+
+ use dollar_mod
+ type(dollar_type) :: money
+ money = dollar_type(50.0)
+ print '(DT)', money ! Make sure that the typebound generic is accessible.
+ end
