procyberian/gcc
1
0
Fork 0
Code Issues Pull requests Projects Releases Packages Wiki Activity Actions

re PR fortran/51995 ([OOP] Polymorphic class fails at runtime)

Browse source 
2012-01-25  Tobias Burnus  <burnus@net-b.de>

        PR fortran/51995
        * class.c (gfc_build_class_symbol): Ensure that
        fclass->f2k_derived is set.

2012-01-25  Tobias Burnus  <burnus@net-b.de>

        PR fortran/51995
        * gfortran.dg/typebound_proc_25.f90: New.

From-SVN: r183528
This commit is contained in:
Tobias Burnus 2012-01-25 18:34:39 +01:00 • committed by Tobias Burnus
parent b3310d4901
commit f5a5c89082
4 changed files with 125 additions and 2 deletions
Show stats Download patch file Download diff file Expand all files Collapse all files

8
gcc/fortran/ChangeLog
View file

@ -1,4 +1,10 @@
2012-01-24 Tobias Burnus <burnus@net-b.de>
2012-01-25 Tobias Burnus <burnus@net-b.de>
PR fortran/51995
* class.c (gfc_build_class_symbol): Ensure that
fclass->f2k_derived is set.
2012-01-25 Tobias Burnus <burnus@net-b.de>
PR fortran/51966
* resolve.c (resolve_structure_cons): Only create an

2
gcc/fortran/class.c
View file

@ -421,6 +421,8 @@ gfc_build_class_symbol (gfc_typespec *ts, symbol_attribute *attr,
c->attr.access = ACCESS_PRIVATE;
c->attr.pointer = 1;
}
else if (!fclass->f2k_derived)
fclass->f2k_derived = fclass->components->ts.u.derived->f2k_derived;
/* Since the extension field is 8 bit wide, we can only have
up to 255 extension levels. */

7
gcc/testsuite/ChangeLog
View file

@ -1,3 +1,8 @@
2012-01-25 Tobias Burnus <burnus@net-b.de>
PR fortran/51995
* gfortran.dg/typebound_proc_25.f90: New.
2012-01-25 Jason Merrill <jason@redhat.com>
PR c++/51992
@ -21,7 +26,7 @@
* gcc.dg/pr50908-2.c (dg-options): Add -fno-short-enums.
2012-01-24 Tobias Burnus <burnus@net-b.de>
2012-01-25 Tobias Burnus <burnus@net-b.de>
PR fortran/51966
* gfortran.dg/derived_constructor_char_3.f90: New.

110
gcc/testsuite/gfortran.dg/typebound_proc_25.f90 Normal file
View file

@ -0,0 +1,110 @@
! { dg-do compile }
!
! PR fortran/51995
!
! Contributed by jilfa12@yahoo.com
!
MODULE factory_pattern
TYPE CFactory
PRIVATE
CHARACTER(len=20) :: factory_type !! Descriptive name for database
CLASS(Connection), POINTER :: connection_type !! Which type of database ?
CONTAINS !! Note 'class' not 'type' !
PROCEDURE :: init !! Constructor
PROCEDURE :: create_connection !! Connect to database
PROCEDURE :: finalize !! Destructor
END TYPE CFactory
TYPE, ABSTRACT :: Connection
CONTAINS
PROCEDURE(generic_desc), DEFERRED, PASS(self) :: description
END TYPE Connection
ABSTRACT INTERFACE
SUBROUTINE generic_desc(self)
IMPORT :: Connection
CLASS(Connection), INTENT(in) :: self
END SUBROUTINE generic_desc
END INTERFACE
!! An Oracle connection
TYPE, EXTENDS(Connection) :: OracleConnection
CONTAINS
PROCEDURE, PASS(self) :: description => oracle_desc
END TYPE OracleConnection
!! A MySQL connection
TYPE, EXTENDS(Connection) :: MySQLConnection
CONTAINS
PROCEDURE, PASS(self) :: description => mysql_desc
END TYPE MySQLConnection
CONTAINS
SUBROUTINE init(self, string)
CLASS(CFactory), INTENT(inout) :: self
CHARACTER(len=*), INTENT(in) :: string
self%factory_type = TRIM(string)
self%connection_type => NULL() !! pointer is nullified
END SUBROUTINE init
SUBROUTINE finalize(self)
CLASS(CFactory), INTENT(inout) :: self
DEALLOCATE(self%connection_type) !! Free the memory
NULLIFY(self%connection_type)
END SUBROUTINE finalize
FUNCTION create_connection(self) RESULT(ptr)
CLASS(CFactory) :: self
CLASS(Connection), POINTER :: ptr
IF(self%factory_type == "Oracle") THEN
IF(ASSOCIATED(self%connection_type)) DEALLOCATE(self%connection_type)
ALLOCATE(OracleConnection :: self%connection_type)
ptr => self%connection_type
ELSEIF(self%factory_type == "MySQL") THEN
IF(ASSOCIATED(self%connection_type)) DEALLOCATE(self%connection_type)
ALLOCATE(MySQLConnection :: self%connection_type)
ptr => self%connection_type
END IF
END FUNCTION create_connection
SUBROUTINE oracle_desc(self)
CLASS(OracleConnection), INTENT(in) :: self
WRITE(*,'(A)') "You are now connected with Oracle"
END SUBROUTINE oracle_desc
SUBROUTINE mysql_desc(self)
CLASS(MySQLConnection), INTENT(in) :: self
WRITE(*,'(A)') "You are now connected with MySQL"
END SUBROUTINE mysql_desc
end module
PROGRAM main
USE factory_pattern
IMPLICIT NONE
TYPE(CFactory) :: factory
CLASS(Connection), POINTER :: db_connect => NULL()
CALL factory%init("Oracle")
db_connect => factory%create_connection() !! Create Oracle DB
CALL db_connect%description()
!! The same factory can be used to create different connections
CALL factory%init("MySQL") !! Create MySQL DB
!! 'connect' is a 'class' pointer. So can be used for either Oracle or MySQL
db_connect => factory%create_connection()
CALL db_connect%description()
CALL factory%finalize() ! Destroy the object
END PROGRAM main
! { dg-final { cleanup-modules "factory_pattern" } }