Intel® Fortran Compiler
Build applications that can scale for the future with optimized code designed for Intel® Xeon® and compatible processors.

Private procedure 'visible' in extending type

Bálint_A_
Beginner
1,705 Views

Dear all,

I think the ifort 16.0.3 (the most recent version I have access to right now), does not handle private procedures correctly. The example below demonstrates the issue. The Base type declares a private type bound procedure. This should not be visible in any sense in the extending type Extended in my opinion. The compiler refuses to compile the code, claiming that 'An overriding binding and its corresponding overridden binding must have the same number of dummy arguments.' But this is contradictory IMO as the procedure in the Base type is private, and should, therefore, not be be visible outside of it. Therefore, it can not be overriden, so that type bound procedures in extending types may have the same name but different calling signature.

Best regards,

Bálint

module basemod
  implicit none
  private

  public :: Base

  type :: Base
    integer :: id
  contains
    procedure, private :: dummy
  end type Base

contains

  subroutine dummy(this, id)
    class(Base), intent(inout) :: this
    integer, intent(in) :: id

    this%id = id
    print *, 'Base'

  end subroutine dummy

end module basemod


module extmod
  use basemod
  implicit none

  type, extends(Base) :: Extended
  contains
    procedure, private :: dummy
  end type Extended

contains

  subroutine dummy(this)
    class(Extended), intent(in) :: this

    print *, 'Extended'

  end subroutine dummy

end module extmod

 

0 Kudos
1 Solution
Steven_L_Intel1
Employee
1,686 Views

Right - this is a bug we JUST fixed, having been clarified by an interpretation to Fortran 2008. I don't yet know when the fix will be included in a product update and will let you know when I find out. Our issue ID is DPD200247485.

View solution in original post

0 Kudos
25 Replies
Steven_L_Intel1
Employee
1,687 Views

Right - this is a bug we JUST fixed, having been clarified by an interpretation to Fortran 2008. I don't yet know when the fix will be included in a product update and will let you know when I find out. Our issue ID is DPD200247485.

0 Kudos
Bálint_A_
Beginner
1,395 Views

Dear Steve,

thank you for your feedback. I am looking forward for the appropriate release.

0 Kudos
FortranFan
Honored Contributor II
1,395 Views

Steve Lionel (Intel) wrote:

Right - this is a bug we JUST fixed, having been clarified by an interpretation to Fortran 2008. I don't yet know when the fix will be included in a product update and will let you know when I find out. Our issue ID is DPD200247485.

Steve,

I'm at a different location with a different computer, so don't have much information and my notes with me at the moment.  But a quick question, how does the interpretation impact code with a deferred private TBP in an abstract derived type and where the extended derived type (the concrete implementation) is in another module?  I believe both Intel Fortran and gfortran currently allow this, but is this now going to be disallowed per the 2008 interp?

module b_m

   implicit none

   private

   type, abstract, public :: b_t
   contains
      private
      procedure(Ip), pass(this), deferred :: p
   end type b_t

   abstract interface
      subroutine Ip( this)
         import :: b_t
         class(b_t), intent(inout) :: this
      end subroutine Ip
   end interface

end module b_m
module e_m

   use b_m, only : b_t

   implicit none

   private

   type, extends(b_t), public :: e_t
   contains
      procedure, pass(this), private :: p => e_p
   end type e_t

contains

   subroutine e_p( this)
      class(e_t), intent(inout) :: this
   end subroutine e_p

end module e_m

 

0 Kudos
Steven_L_Intel1
Employee
1,395 Views

From the perspective of the interp, the private deferred binding is not visible in module e_m so it's as if it never existed. Therefore this code is ok. Here's the text of the interp:

NUMBER: F08/0052
TITLE: Private type-bound procedures
KEYWORDS: Type extension, type-bound procedures, accessibility
DEFECT TYPE: Erratum
STATUS: Passed by WG5 letter ballot

QUESTION:

Consider the program

  MODULE example1_m1
    TYPE t1
    CONTAINS
      PROCEDURE,PRIVATE,NOPASS :: p ! (1).
    END TYPE
  CONTAINS
    SUBROUTINE p
      PRINT *,'p'
    END SUBROUTINE
    SUBROUTINE do_p(x)
      CLASS(t1) x
      CALL x%p
    END SUBROUTINE
  END MODULE
  MODULE example1_m2
    USE example1_m1
    TYPE,EXTENDS(t1) :: t2
    CONTAINS
      PROCEDURE,NOPASS :: p => p2 ! (2).
    END TYPE
  CONTAINS
    SUBROUTINE p2(n)
      PRINT *,'p2',n
    END SUBROUTINE
  END MODULE
  PROGRAM example1
    USE example1_m2
    TYPE(t2),TARGET :: x
    CLASS(t1),POINTER :: y
    y => x
    CALL do_p(x) ! (3): I expect this to print 'p'.
    CALL do_p(y) ! (4): I expect this to print 'p'.
    CALL x%p(13) ! (5): I expect this to print 'p2 13'.
  END PROGRAM

Question 1: does type-bound procedure overriding take account of
accessibility; that is, is the type-bound procedure statement at (2)
(a) a valid new type-bound procedure definition, or
(b) an invalid overriding of the definition at (1)?

Question 2: If the answer to question 1 was "yes" (a), and the example
is standard-conforming, are the expectations at (3), (4), and (5)
correct?

For the next question, consider the following program fragment:

  MODULE example2_m1
    TYPE,ABSTRACT :: t1
    CONTAINS
      PROCEDURE(p),PRIVATE,DEFERRED,NOPASS :: hidden ! (6).
    END TYPE
  CONTAINS
    SUBROUTINE p
      PRINT *,'p'
    END SUBROUTINE
  END MODULE
  MODULE example2_m2
    USE example2_m1
    TYPE,EXTENDS(t1) :: t2
    CONTAINS
      PROCEDURE,NOPASS :: hidden => exposed ! (7).
    END TYPE
  CONTAINS
    SUBROUTINE exposed
      PRINT *,'exposed'
    END SUBROUTINE
  END MODULE

Question 3: If the answer to question 1 was "yes" (a), then the
definition of type t2 would seem to be defective in that (7) must be
defining a new type-bound procedure, and not overriding the type-bound
procedure defined at (6), and that therefore t2 still has a deferred
type-bound procedure.  That would mean that an abstract type with a
private deferred type-bound procedure could not be extended outside of
the module in which it is defined: is that correct?

ANSWER:

Q1. Yes, type-bound procedure overriding does take account of
    accessibility.  This means that the type-bound procedure statement
    at (2) is (a) a valid new type-bound procedure definition.

    Subclause 4.5.7.3p1 says [78:4-6]
      "If a specific type-bound procedure specified in a type
       definition has the same binding name as a type-bound procedure
       from the parent type then [it] overrides the [inherited one]."
    If the inherited type-bound procedure is private, and the
    extending type definition is not in the same module, then the
    inherited type-bound procedure is not accessible by that name,
    so the condition "has the same binding name" cannot be satisfied.

    This wording is very confusing, so an edit is supplied to clarify
    the intent.

Q2. Yes, the comments at (3), (4), and (5) are accurate.

Q3. Yes, an abstract type with a private deferred type-bound procedure
    cannot be extended outside the defining module, because it is
    otherwise impossible to override the private type-bound procedure.

EDITS to 10-007r1:

[78:4] In 4.5.7.3p1,
       change "as a type-bound"
       to "as an accessible type-bound".

SUBMITTED BY: Malcolm Cohen

HISTORY: 11-141    m194  F08/0052 submitted - passed by J3 meeting
         11-207r1  m195  Passed as amended by J3 letter ballot #23
                          11-156
         N1889             Passed by WG5 letter ballot

0 Kudos
IanH
Honored Contributor II
1,395 Views

Steve Lionel (Intel) wrote:

From the perspective of the interp, the private deferred binding is not visible in module e_m so it's as if it never existed. Therefore this code is ok.

If "this code" means Fortran Fan's example, then I think that should be "not ok" - per question three of the interp.

The result of the interp results in a capability gap for authors when they want a binding that can be overriden but not invoked - which is what I guess was the intent of the code in Fortran Fan's example.  It would be nice to see the language address this in the future.

 

0 Kudos
FortranFan
Honored Contributor II
1,395 Views

ianh wrote:

Quote:

Steve Lionel (Intel) wrote:

 

From the perspective of the interp, the private deferred binding is not visible in module e_m so it's as if it never existed. Therefore this code is ok.

 

If "this code" means Fortran Fan's example, then I think that should be "not ok" - per question three of the interp.

 

The result of the interp results in a capability gap for authors when they want a binding that can be overriden but not invoked - which is what I guess was the intent of the code in Fortran Fan's example.  It would be nice to see the language address this in the future.

 

Yes, that is exactly what I meant.  Re: "It would be nice to see the language address this in the future" - I agree totally.

Steve,

Will it be possible for you (and/or other representatives from Intel on the standards committee) to take this request into consideration and add it to a possible list of items Intel may be keeping for bringing up with the committee whenever works begin on the next major revision i.e., the one following the current 2015 version in progress?

All,

A thought I had was to extend (!) the EXTENDS facility in the language to MODULEs as well and to introduce OVERRIDABLE keyword and see if this can address the "capability gap" mentioned by IanH above.  For example, say the language allowed the following:

module, overridable :: b_m
   ! NOTICE the keyword above implying this module is EXTENSIBLE
   ! By default, modules are to be NON_OVERRIDABLE

   implicit none

   private

   type, abstract, public :: b_t
   contains
      private
      procedure(Ip), pass(this), deferred :: p
   end type b_t

   abstract interface
      subroutine Ip( this)
         import :: b_t
         class(b_t), intent(inout) :: this
      end subroutine Ip
   end interface

end module b_m
module, extends(b_m) e_m
   ! NOTICE extends keyword above

   implicit none

   private

   type, extends(b_t), public :: e_t
   contains
      procedure, pass(this) :: p => e_p
   end type e_t

contains

   subroutine e_p( this)
      class(e_t), intent(inout) :: this
   end subroutine e_p

end module e_m

Then can one effectively view a new module (e_m) as belonging to the same scope as base module (b_m) and thereby what's *private* to b_m can become accessible to the extended module.  Developers of base module can mark it as either OVERRIDABLE (or a keyword of another name , say EXTENSIBLE) or NON_OVERRIDABLE (a keyword which already exists in the context of TBPs or a new one, say NON_EXTENSIBLE).  The default will be such as to be consistent with existing code.  I wonder if this can give flexibility to coders when it comes to extending derived types.  My thought is to introduce functionality somewhat similar to "internal" (or protected or even friend) inheritance in other OO languages where "children" can access certain information from "parents" that others cannot.

I'm not suggesting the above has been totally 'fleshed' out in my mind or it should be the only approach or that it will take care of everything - it will be nice if Intel can give it further thought and engage the committee toward a solution.

Thanks,

 

0 Kudos
Steven_L_Intel1
Employee
1,395 Views

I'll take another look at this next week. I hadn't spotted a problem before. I can certainly raise the issue with the committee if there seems to be a problem.

0 Kudos
Steven_L_Intel1
Employee
1,395 Views

Spent quite a bit of time on this one. Indeed, the code in post 4 is not allowed, because one can't override a nonaccessible deferred binding per F08/0052. (Intel Fortran doesn't yet recognize that.) But what if you just declared a new binding p, would that be ok? No, as there is apparently a rule that if you extend an abstract type with deferred procedures, you must override all of the deferred procedures, and since you can't access the private ones, you can't extend the type. This is stated twice in the interp (in Q3 and its answer), and indeed Intel Fortran complains if you don't override all of the deferred bindings.

My problem is that I haven't yet found where in the standard it says you have to override all the deferred bindings. I am sure it is there somewhere, but I spent hours searching back into F2003 and could not spot it. Maybe you folks have an idea? I sent out an email to the J3 list earlier today but have had no replies yet - maybe tomorrow. I also included the stated desire to be able to have overrideable but non-usable bindings.

0 Kudos
FortranFan
Honored Contributor II
1,395 Views

Steve Lionel (Intel) wrote:

Spent quite a bit of time on this one. Indeed, the code in post 4 is not allowed, because one can't override a nonaccessible deferred binding per F08/0052. (Intel Fortran doesn't yet recognize that.) But what if you just declared a new binding p, would that be ok? No, as there is apparently a rule that if you extend an abstract type with deferred procedures, you must override all of the deferred procedures, and since you can't access the private ones, you can't extend the type. This is stated twice in the interp (in Q3 and its answer), and indeed Intel Fortran complains if you don't override all of the deferred bindings.

My problem is that I haven't yet found where in the standard it says you have to override all the deferred bindings. I am sure it is there somewhere, but I spent hours searching back into F2003 and could not spot it. Maybe you folks have an idea? I sent out an email to the J3 list earlier today but have had no replies yet - maybe tomorrow. I also included the stated desire to be able to have overrideable but non-usable bindings.

Steve,

I couldn't locate any rule or constraint in WD 1539-1 J3/10-007r1 (F2008 Working Document) that states or directly implies, "if you extend an abstract type with deferred procedures, you must override all of the deferred procedures".

However, see section 4.5.5 Type-bound procedures, point 2, lines 15 and 16 which say, "The DEFERRED keyword shall appear only in the definition of an abstract type."

See also section 4.5.7.2 Inheritance which says under point 1, "An extended type includes all of the type parameters, all of the components, and the non-overridden type-bound procedures of its parent type. These are inherited by the extended type from the parent type. They retain all of the attributes that they had in the parent type."

Points such as above lead to a state where an extended type, if not abstract itself, has to provide concrete bindings for all the deferred procedures it has inherited.

Hopefully the responses you receive from the J3 mailing list will clear this up.

Nonetheless, as you state, F08/0052 interp is clear in ruling out code in Quote #4 and regardless of the current text of the standard, I expect the requirement for a developer will be that "if you extend an abstract type with deferred procedures, you must override all of the deferred procedures".  Under these circumstances, it is a gap, as mentioned by IanH, since developers do INDEED NEED the functionality suggested by the code in Quote #4.  Hence I hope there will be some solution worked out eventually in the standard toward such needs.

Separately, I'm not sure what you mean by ".. have overrideable but non-usable bindings."  Please note in quite a few instances, the overridden bindings do indeed need to be used, just not invoked directly e.g., they may get used via a generic binding.

Thanks,

0 Kudos
IanH
Honored Contributor II
1,395 Views

Another use case, beyond specific bindings supporting a generic binding, illustrated with the following.  Module `a` represents some sort of library with a well defined interface for clients (the procedure `Proc`) and provision for specific implementation or extension through an abstract type.  Module `b` is then an example of a specific implementation - provided by extending the abstract type.  Program `c` represents the client code that uses the general library support with the specific implementation.  `a`, `b` and `c` might be maintained by three separate groups of programmers, and the interface between the library and its implementations and the interface between the library and clients of the library are independent.  (At a bigger scale - this is the same model as operating system (a)/device driver (b)/application (c).)

It doesn't make sense for clients to directly call the implementation - they need to work through the library wrapper, and it would be nice-to-have some way of setting up the accessibility/overridability of the binding to be consistent with that.  Prior to that interp, I assumed that making the binding PRIVATE would achieve this.  Oh well.

MODULE a
  IMPLICIT NONE
  PRIVATE
  
  TYPE, ABSTRACT, PUBLIC :: parent
  CONTAINS
    PROCEDURE(parent_binding), DEFERRED, OVERRIDABLE_BUT_NOT_INVOKABLE :: binding
  END TYPE parent
  
  ABSTRACT INTERFACE
    SUBROUTINE parent_binding(object)
      IMPORT :: parent
      IMPLICIT NONE
      CLASS(parent), INTENT(INOUT) :: object
    END SUBROUTINE parent_binding
  END INTERFACE
  
  PUBLIC :: Proc
CONTAINS
  SUBROUTINE Proc(object)
    CLASS(parent), INTENT(INOUT) :: object
    
    ! Common prologue code goes here.
    ! xxxx
    
    ! Invoke extension specific behaviour...
    CALL object%binding()
    
    ! Common epilogue code goes here.
    ! zzzz
    
  END SUBROUTINE Proc
END MODULE a

MODULE b
  USE a
  
  IMPLICIT NONE
  PRIVATE
  
  TYPE, EXTENDS(parent), PUBLIC :: child
  CONTAINS
    PROCEDURE, PRIVATE :: binding => child_binding
  END TYPE child
CONTAINS
  SUBROUTINE child_binding(object)
    CLASS(child), INTENT(INOUT) :: object
    ! Implementation for a specific extension.
    ! yyyy
  END SUBROUTINE child_binding
END MODULE b

PROGRAM c
  USE a
  USE b
  IMPLICIT NONE
  
  TYPE(child) :: object
  
  CALL Proc(object)
END PROGRAM c

See http://www.gotw.ca/publications/mill18.htm for a C++ take on the arrangement, mapping a Fortran binding to a "virtual function" and a deferred binding to a pure virtual function.

The interp suggests that you can re-use an inaccessible binding name in an extension.  Are the rules around bindings and components the same in this regard?  Current ifort complains about the re-use of inaccessible component names (I thought this was non-conforming too, not that I can now find text to support that).

MODULE m1
  IMPLICIT NONE
  TYPE :: parent
    INTEGER, PRIVATE :: comp
  END TYPE parent
END MODULE m1

MODULE m2
  USE m1
  TYPE, EXTENDS(parent) :: extension
    INTEGER :: comp
  END TYPE extension
END MODULE m2

(The resulting diagnostic message paraphrases F2008 Note 4.55, but it is a bit off - as the component is not accessible.)

0 Kudos
Steven_L_Intel1
Employee
1,395 Views

With the help of another committee member, I located the constraint (this is from the F2015 draft, note that the clause (chapter) numbers have changed):

C734 (R726) If the type definition contains or inherits (7.5.7.2) a deferred type-bound procedure (7.5.5), ABSTRACT shall appear.

I had seen this many times but didn't connect the dots. The critical word is "inherits". If an extended type inherits a deferred TBP and doesn't override it, it has to also call it deferred, which only an abstract type can do. That implies that if extending such a type not as abstract, you must override all inherited deferred bindings.

The part I was still confused about was whether the private TBPs are inherited even if they are not accessible. Malcolm Cohen says they are. He further says:

The requirement to have all deferred type-bound procedures overridden in a non-ABSTRACT type does not come out of this interp.  It comes out of the basic requirement that it be impossible to invoke a deferred tbp.  If you want to instantiate something without overriding a tbp, simply don't make that tbp deferred - put in a stub that does an ERROR STOP.

It is literally impossible for a concrete object ever to have the capabilities of:

(a) a binding can be overridden
(b) that binding cannot be invoked

except in the case when the procedure has a nonoptional nonpointer nonallocatable dummy argument for which it is impossible to create any acceptable actual argument, e.g. by having it be of a nonsequence type private to the procedure.

The following note makes this clearer:

Inaccessible components and bindings of the parent type are also inherited, but they remain inaccessible in
the extended type. Inaccessible entities occur if the type being extended is accessed via use association and
has a private entity.

0 Kudos
FortranFan
Honored Contributor II
1,395 Views

Steve,

Thanks for the update.

So where does all this leave a Fortran coder in terms of the gap explained by IanH in Quote #6 and an additional use case provided by him in Quote #10?

 

0 Kudos
Steven_L_Intel1
Employee
1,395 Views

Malcolm Cohen's suggestion of a stub procedure that does an ERROR STOP or some such, non-deferred, would seem plausible. It also occurs to me that you could specify an external procedure that doesn't exist, so you'd get a link-time error.

0 Kudos
FortranFan
Honored Contributor II
1,395 Views

Steve Lionel (Intel) wrote:

Malcolm Cohen's suggestion of a stub procedure that does an ERROR STOP or some such, non-deferred, would seem plausible. It also occurs to me that you could specify an external procedure that doesn't exist, so you'd get a link-time error.

Steve,

Consider IanH's example code in Quote #11: I don't understand how Malcolm Cohen's suggestion helps with the use case presented in that example.  Can you elaborate?

0 Kudos
IanH
Honored Contributor II
1,395 Views

Steve Lionel (Intel) wrote:

Malcolm Cohen's suggestion of a stub procedure that does an ERROR STOP or some such, non-deferred, would seem plausible. It also occurs to me that you could specify an external procedure that doesn't exist, so you'd get a link-time error.

This is patently teaching grandma how to suck eggs, but bear with me while I try and present a reasoned argument from the perspective of someone who knows more about breaking rocks into little pieces than writing software...

Language features, such as accessibility and deferred bindings, exist so that source code can approximately describe to human readers and the Fortran processor the conceptual arrangement of the source - this thing is private, so regard it as implementation detail; this thing is deferred, it represents behaviour that extensions have to provide.  Because a processor understands those features, it can help programmers when they violate the conceptual arrangement, by being able/required to provide reasonably meaningful compile time (for Fortran processors that include a compiler) diagnostics.

But the language lacks the ability to describe the conceptual arrangement in #11 (or the need to provide specific bindings for a generic), in what I would regard as a satisfactory manner.

It is unreasonable to expect the language to be able to describe every conceptual arrangement perfectly, but the concept in #11 is reasonably common.  Some of the points made around separation of interface from implementation detail in software design (which are independent of language), made in that C++ guru of the week post I linked to above, suggest that it should perhaps be more commonly used than it is.

In terms of what is or is not satisfactory - pretty much the entire capability provided by deferred bindings, independent of accessibility, could also be implemented using "default" bindings that invoked stop, or specific bindings referencing non-existent external procedures.  But those language design choices weren't selected when the capability provided by deferred bindings was introduced to the language, the same reasons for why they weren't used for implementation of the capability of deferred bindings in general are the same reasons that they are not really satisfactory for solving this use case - they are just work-arounds.

(If you have control over the source that provides the abstract type, then I think the easiest work-around is to simply make the deferred binding public, or just stick the extension type in [a descendent of] the same module.  If the author of the extension fails to implement the binding, the compiler will tell them directly at compile time, which I think preferable to only learning (via the client!) about their mistake at runtime or getting some relatively obscure linker error.  This accepts the cost that the author of the client code might call the binding directly.  Fortran's accessibility model cannot adequately express the desired conceptual arrangement, so simply stop using Fortran's accessibility model.  But from the software design perspective, the programmers for library, implementation and client are three distinct entities, they agree on interfaces, but have no control over each other's internal implementation.)

 

0 Kudos
Bálint_A_
Beginner
1,395 Views

Look at the following code. It should roughly satisfy Ians criteria about separating interface and implementation detail and also according to the C++ post FortranFan linked. However, depending which compiler you invoke (I've tried gfortran 6.1, nag 6.1 and ifort 16) results are different. Ifort and gfortran would invoke the implementationDetail of the extended type (Extended), while the nag compiled code invokes the same method of the base class (Base). Why former is the desired behaviour, latter is the standard conforming one.

However, by introducing the attribute `overridable` in the standard, we could easily allow for the desired behaviour in back compatible way. Right now, by default all public functions are overridable and all private ones are effectively non-overridable (in the sense that they are invisible in extending types). Let's allow private methods be marked 'overridable', causing them to be visible (and overridable) in extending types, but not accessible or visible from outside. I included the proposed language changes as comments in the code below. Of course, in every extending type, the 'overridable' private functions would have to keep their overridable attribute. Of course, extending types would then be able to call the overridable private methods of their base type, which I guess, would fit neatly in the desired design pattern.

Ian, FortranFan, would that satisfy your requirements? Steve, can you see any fundamental flaw in such a language extension?

module basemod
  implicit none
  private

  public :: Base

  type :: Base  ! Could be even made abstract, if implementationDetail() is deferred
  contains
    procedure, non_overridable :: publicInterface
    procedure, private :: implementationDetail
    !procedure, private, overridable :: implementationDetail  ! could be even made deferred if wished
  end type Base

contains

  subroutine publicInterface(this)
    class(Base), intent(in) :: this
    
    print *, 'Base%publicInterface'
    call this%implementationDetail()

  end subroutine publicInterface


  subroutine implementationDetail(this)
    class(Base), intent(in) :: this

    print *, 'Base%implementationDetail'

  end subroutine implementationDetail

end module basemod


module extmod
  use basemod
  implicit none
  private

  public :: Extended

  type, extends(Base) :: Extended
  contains
    procedure, private :: implementationDetail
    !procedure, private, overridable :: implementationDetail
  end type Extended

contains

  subroutine implementationDetail(this)
    class(Extended), intent(in) :: this

    print *, 'Extended%implementationDetail'

  end subroutine implementationDetail

end module extmod


program test
  use extmod

  type(Extended) :: instance


  call instance%publicInterface()

end program test

 

0 Kudos
FortranFan
Honored Contributor II
1,395 Views

Steve, IanH:

I wonder if we are all on the same page re: the fundamental issue expressed in Message #4, Message #6, #7, and Message #11: the issue is NOT about any complaints by coders about why a concrete type extending an abstract type is required to provide bindings for a private, deferred type-bound procedure when it is not allowed to do so per interp F08/0052 and how one may workaround it via specific bindings and a stub and such stuff from Malcolm Cohen's comments.

IanH, correct me if I'm wrong, but for me the gap lies in the fact that users indeed have design needs to include private, deferred TBPs in abstract derived types as shown by the use case in Message #11 and that the standard doesn't provide sufficient facilities for various possibilities that may arise, as explained in Message #11.  Steve, your feedback based on J3 mailing list or Malcolm Cohen's comments do not appear to address this aspect.  Hence the question remains: do you have any suggestions on what Intel reps on the standard committee can do for Intel Fortran customers with respect to this gap in the Fortran standard? 

 

0 Kudos
FortranFan
Honored Contributor II
1,395 Views

Bálint A. wrote:

.. according to the C++ post FortranFan linked. ..

Ian, FortranFan, would that satisfy your requirements? Steve, can you see any fundamental flaw in such a language extension? ..

@Bálint A.,

A correction: IanH provided the C++ link! :-)

A couple of comments on your post:

1.  I think DEFERRED attribute implies overridable.  Besides, if not marked NON_OVERRIDABLE, a binding is overridable.  Hence it's not immediately clear to me what, if any, change to the standard language or syntax will be helpful re: type-bound procedures.

2.  The attributes PRIVATE/PUBLIC even in connection with derived types apply with respect to MODULE scope.  If one has flexibility, as expressed by IanH, in always being to include an abstract type and an extended concrete type in the same module, then the concern expressed in this thread is moot.  As explained by IanH, 3 different entities can come into play and thus "a capability gap for authors when they want a binding that can be overriden but not invoked .. It would be nice to see the language address this in the future."  

 

0 Kudos
Bálint_A_
Beginner
1,395 Views

I was probably to enthusiastic about the possibility to propose a useful language change, sorry! :-)

A correction: IanH provided the C++ link! :-

Sorry for the wrong credits!

The attributes PRIVATE/PUBLIC even in connection with derived types apply with respect to MODULE scope

This is indeed a point I was not thinking about. To me, it still feels very unnaturally that an access controller (private attribute), which is declared within a derived type regulates accessibility with respect of the hosting scope of this entity (on the module level) and not with respect of the derived type itself (whether it can be accessed from outside of the derived type). As I always put each derived type definition in separate module, I never really realized it, I guess.

But does that mean, that you can override a private method, as long as you do that within the same module?

 I think DEFERRED attribute implies overridable.  Besides, if not marked NON_OVERRIDABLE, a binding is overridable.  Hence it's not immediately clear to me what, if any, change to the standard language or syntax will be helpful re: type-bound procedures.

Well, that is currently not true for private methods as they are effectively non-overridable, as you don't see them outside of the derived type. (Or to be more precise, outside of the module). But I see your point, if the private/public attributes regulate accessibility on the module level, any language extension which handles this, must tackle it on the module level. (After more then a decade, Fortran still keeps surprising me :-)).

0 Kudos
FortranFan
Honored Contributor II
1,181 Views

Bálint A. wrote:

.. But does that mean, that you can override a private method, as long as you do that within the same module? .. 

Yes indeed, the scope is at the module level

See IanH's comment in Message #16, "(If you have control over the source that provides the abstract type, then I think the easiest work-around is to simply make the deferred binding public, or just stick the extension type in [a descendent of] the same module"

 

0 Kudos
Reply