OpenCores
URL https://opencores.org/ocsvn/openrisc_2011-10-31/openrisc_2011-10-31/trunk

Subversion Repositories openrisc_2011-10-31

[/] [openrisc/] [tags/] [gnu-src/] [gcc-4.5.1/] [gcc-4.5.1-or32-1.0rc2/] [gcc/] [testsuite/] [gfortran.dg/] [class_12.f03] - Diff between revs 302 and 384

Go to most recent revision | Only display areas with differences | Details | Blame | View Log

Rev 302 Rev 384
! { dg-do compile }
! { dg-do compile }
!
!
! PR 41556: [OOP] Errors in applying operator/assignment to an abstract type
! PR 41556: [OOP] Errors in applying operator/assignment to an abstract type
!
!
! Contributed by Damian Rouson 
! Contributed by Damian Rouson 
module abstract_algebra
module abstract_algebra
  implicit none
  implicit none
  private
  private
  public :: rescale
  public :: rescale
  public :: object
  public :: object
  type ,abstract :: object
  type ,abstract :: object
  contains
  contains
    procedure(assign_interface) ,deferred :: assign
    procedure(assign_interface) ,deferred :: assign
    procedure(product_interface) ,deferred :: product
    procedure(product_interface) ,deferred :: product
    generic  :: assignment(=) => assign
    generic  :: assignment(=) => assign
    generic  :: operator(*) => product
    generic  :: operator(*) => product
  end type
  end type
  abstract interface
  abstract interface
    function product_interface(lhs,rhs) result(product)
    function product_interface(lhs,rhs) result(product)
      import :: object
      import :: object
      class(object) ,intent(in)  :: lhs
      class(object) ,intent(in)  :: lhs
      class(object) ,allocatable :: product
      class(object) ,allocatable :: product
      real          ,intent(in)  :: rhs
      real          ,intent(in)  :: rhs
    end function
    end function
    subroutine assign_interface(lhs,rhs)
    subroutine assign_interface(lhs,rhs)
      import :: object
      import :: object
      class(object) ,intent(inout) :: lhs
      class(object) ,intent(inout) :: lhs
      class(object) ,intent(in)    :: rhs
      class(object) ,intent(in)    :: rhs
    end subroutine
    end subroutine
  end interface
  end interface
contains
contains
  subroutine rescale(operand,scale)
  subroutine rescale(operand,scale)
    class(object)    :: operand
    class(object)    :: operand
    real ,intent(in) :: scale
    real ,intent(in) :: scale
    operand = operand*scale
    operand = operand*scale
    operand = operand%product(scale)
    operand = operand%product(scale)
  end subroutine
  end subroutine
end module
end module
! { dg-final { cleanup-modules "abstract_algebra" } }
! { dg-final { cleanup-modules "abstract_algebra" } }
 
 

powered by: WebSVN 2.1.0

© copyright 1999-2024 OpenCores.org, equivalent to Oliscience, all rights reserved. OpenCores®, registered trademark.