11-229 To: J3 Members From: Stan Whitlock Subject: J3 Fortran interp letter ballot #24 - due 19-Aug-2011 Date: 2011 July 18 Enclosed in the next letter ballot on Fortran interpretations. The rules by which we operate say: o J3 votes on the answer at a J3 meeting; a simple majority vote marks the answer as "passed by J3 meeting". o Between J3 meetings the chair of /interp sends a J3 letter ballot to J3 to approve interp answers that have been "passed by J3 meeting". The letter ballot runs for 30 days. Not voting on three of four consecutive J3 letter ballots is grounds to terminate J3 membership. An interp answer passes by a 2/3rds vote; a no vote must be accompanied by an explanation of the changes necessary to change the member's vote to yes. J3/interp reserves the right to recall an interp answer for more study even if the answer passes. 20 Fortran interpretations are currently "Passed by J3 meeting" after J3 meeting #195. This is the letter ballot phase to go from "Passed by J3 meeting" to "Passed by J3 letter ballot". The following Fortran interpretations are being balloted: Yes No Number Title --- --- F03/0017 Dummy procedure pointers and PRESENT --- --- F03/0018 Multiple identical specific procedures in type-bound generic --- --- F03/0019 Multiple identical specific procedures in generic interface blocks --- --- F03/0021 What kind of token is a stop code? --- --- F03/0046 Unlimited polymorphic pointers in common blocks --- --- F03/0053 The BIND attribute for C_PTR and C_FUNPTR --- --- F03/0065 Relational equivalence --- --- F03/0084 IEEE_SET_ROUNDING_MODE in a subroutine --- --- F03/0103 Restrictions on dummy arguments not present for polymorphic type or parameterized derived type --- --- F03/0116 indistinguishable specifics for a generic interface with use association --- --- F03/0118 Are lower bounds of assumed-shape arrays assumed? --- --- F03/0120 When are parameterized sequence types the same type? --- --- F08/0055 G editing for reals --- --- F08/0056 Non-polymorphic ALLOCATE with polymorphic SOURCE= --- --- F08/0057 Interoperability with empty types --- --- F08/0058 ENTRY point RESULT variable --- --- F08/0059 Auto-targetting requirements --- --- F08/0060 Procedure pointer assignment with an EXTERNAL target --- --- F08/0061 Description of the CONTIGUOUS attribute misworded? --- --- F08/0062 Mixing default initialization with DATA initialization The text of these interpretations is attached. Each interpretation starts with a row of "-"s. Please mark the above -Y- in the Yes column for "yes", -C- in the Yes column for "yes with comment", or -N- in the No column for a "no" answer {be sure to include your reasons with "no"} and send only the above text {not this entire mail message} with any comments to j3@j3-fortran.org by 11:59:59PM, PDT, Friday, 19-Aug-2011, in order to be counted. Thanks /Stan ---------------------------------------------------------------------- F03/0017 == 11-213 F03/0084 == 11-218 F08/0057 == 11-195 F03/0018 == 11-214 F03/0103 == 11-223 F08/0058 == 11-196r1 F03/0019 == 11-221 F03/0116 == 11-219r1 F08/0059 == 11-197r1 F03/0021 == 11-212r1 F03/0118 == 11-215 F08/0060 == 11-198 F03/0046 == 11-216 F03/0120 == 11-224 F08/0061 == 11-199r2 F03/0053 == 11-217r1 F08/0055 == 11-174r2 F08/0062 == 11-201r1 F03/0065 == 11-222 F08/0056 == 11-194r1 --------------------------------------------------------------------- NUMBER: F03/0017 TITLE: Dummy procedure pointers and PRESENT KEYWORDS: Dummy argument, procedure pointer, PRESENT DEFECT TYPE: Interpretation STATUS: Passed by J3 meeting QUESTION: Does the following program conform to the Fortran standard? procedure(real), pointer :: F => null() call s ( f ) contains subroutine S ( F ) procedure(real), optional, pointer :: F print *, present(f) end subroutine S end In the Fortran 2003 standard (ISO/IEC 1539-1:2004), the second paragraph of 12.4.1.3 requires that if the dummy argument does not have the POINTER attribute and the actual argument does, the actual argument shall be associated. It is not clear in 13.7.91 whether the argument of PRESENT has or has not the POINTER attribute. ANSWER: The program is standard-conforming. The Fortran 2008 standard states "Except in references to intrinsic inquiry functions, a pointer actual argument that corresponds to a nonoptional nonpointer dummy argument shall be pointer associated with a target." (12.5.2.3 paragraph 1). Since PRESENT is an intrinsic inquiry function, there is therefore no requirement on its actual argument that if it is a pointer it shall be associated. EDITS to 10-007r1: None. SUBMITTED BY: Van Snyder HISTORY: 04-402 m170 F03/0017 submitted 04-402r2 m170 Passed by J3 meeting 05-146 m171 Failed J3 letter ballot #10 11-213 m195 Revised answer - Passed by J3 meeting ---------------------------------------------------------------------- NUMBER: F03/0018 TITLE: Multiple identical specific procedures in type-bound generic KEYWORDS: Type-bound generic DEFECT TYPE: Clarification STATUS: Passed by J3 meeting QUESTION: Q1. Does the following program unit conform to the Fortran standard? module M1 type T integer x contains procedure :: MyAdd_t => myadd generic :: operator(+) => myAdd_t end type T type X real q contains procedure, pass(b) :: MyAdd_x => myadd generic :: operator(+) => myAdd_x end type X contains integer function MyAdd ( A, B ) class(t), intent(in) :: A class(x), intent(in) :: B myadd = a%x + b%q end function MyAdd end module Q2. Does the following program unit conform to the Fortran standard? module M2 interface operator(+) procedure MyAdd end interface type T integer x contains procedure :: MyAdd_t => myadd generic :: operator(+) => myAdd_t end type T contains integer function MyAdd ( A, B ) class(t), intent(in) :: A real, intent(in) :: B myadd = a%x + b end function MyAdd end module Q3. If the interface block and type definition are exchanged in question 2, does the program unit conform to the Fortran standard? ANSWER: A1. The program unit is not standard-conforming. Generic operator (+) has two ambiguous specific bindings, one to myadd_t the other to myadd_x. A2. The program unit is not standard-conforming. Generic operator (+) has two ambiguous specific procedures, one being the module procedure myadd the other being the type-bound procedure myadd_t. A3. The ordering of the interface block and the type definition is immaterial. EDITS to 10-007r1: None SUBMITTED BY: Van Snyder HISTORY: 04-405 m170 F03/0018 submitted 04-405r1 m170 Passed by J3 meeting 05-146 m171 Passed J3 letter ballot #10 N1658 m176 Failed WG5 ballot N1657 11-214 m195 Revised answer - Passed by J3 meeting ---------------------------------------------------------------------- NUMBER: F03/0019 TITLE: Multiple identical specific procedures in generic interface blocks KEYWORDS: Type-bound generics DEFECT TYPE: Erratum STATUS: Passed by J3 meeting QUESTION: Consider Module m12 Interface g1 Subroutine s End End Interface Interface g2 Procedure s End Interface End Module Program p12 Use m12 Interface g1 ! (1) Procedure s End Interface Interface g2 ! (2) Procedure s End Interface Call g1 Call g2 End Program It is clear that the interface block marked (2) is not conforming, since it violates C1209 which says "A procedure-name shall not specify a procedure that is specified previously in any procedure-stmt in any accessible interface with the same generic identifier." However, it is not clear whether the interface block marked (1) is conforming, since s was specified previously by an interface-body not a procedure-stmt, even though both (1) and (2) attempt to do the same thing, viz create a generic interface with a duplicate specific. An even more obscure example is Module mx12 Interface g3 Subroutine s End End Interface Private s End Program px12 Use mx12 Interface g3 Subroutine s End End Interface Call g3 End Program Here there is clearly no violation of C1209 but it is not obvious whether the ambiguity rules are applied or not. ANSWER: These examples were not intended to be conforming. An edit is supplied to clarify. EDITS to 10-007r1: [281:11-12] Replace C1209 entirely by "C1209 (R1201) An in a generic interface block shall not specify a procedure that is specified previously in any accessible interface with the same generic identifier." SUBMITTED BY: Van Snyder HISTORY: 04-406 m170 F03/0019 submitted 04-406r1 m170 Passed by J3 meeting 05-146 m171 Passed J3 letter ballot #10 N1658 m176 Failed WG5 ballot N1657 11-221 m195 Revised answer - Passed by J3 meeting ---------------------------------------------------------------------- NUMBER: F03/0021 TITLE: What kind of token is a stop code? KEYWORDS: STOP, token DEFECT TYPE: Erratum STATUS: Passed by J3 meeting QUESTION: The , when it is a string of s, does not appear to be specified by the standard to be any particular kind of token. Or indeed whether it is one token per or one per . The answer to these questions determines whether blanks are allowed, disallowed, or optional, in the middle of a STOP statement in free form. Consider the following statements: (1) STOP 123 (2) STOP123 (3) STOP 1 2 3 Which, if any, of these statements are standard-conforming? ANSWER: Fortran 2008 has revised the syntax of the STOP statement. The is now a scalar integer constant expression or a scalar default character constant expression. Therefore only statement (1) is standard-conforming in free form. EDITS to 10-007r1: None. SUBMITTED BY: Malcolm Cohen HISTORY: 04-416 m170 F03/0021 submitted - Passed by J3 meeting 05-146 m171 Failed J3 letter ballot #10 11-212r1 m195 Revised answer - Passed by J3 meeting ------------------------------------------------------------------------ NUMBER: F03/0046 TITLE: Unlimited polymorphic pointers in common blocks KEYWORDS: Unlimited polymorphic pointer, common block DEFECT TYPE: Clarification STATUS: Passed by J3 meeting QUESTION: Does the following program conform to the Fortran 2008 standard? PROGRAM foo COMMON /blk1/ x CLASS(*), POINTER :: x CALL sub END PROGRAM ANSWER: No. C5100 in Fortran 2008 prohibits unlimited polymorphic pointers in common. EDITS to 10-007r1: None. SUBMITTED BY: Rob James HISTORY: 05-137 m171 F03/0046 submitted - passed by J3 meeting 05-170 m172 Passed J3 letter ballot #11 N1622 m172 Failed WG5 ballot N1629 11-216 m195 Revised answer for Fortran 2008 - Passed by J3 meeting ---------------------------------------------------------------------- NUMBER: F03/0053 TITLE: The BIND attribute for C_PTR and C_FUNPTR KEYWORDS: BIND attribute, C_PTR, C_FUNPTR, private components DEFECT TYPE: Erratum STATUS: Passed by J3 meeting QUESTION: 1. Do the derived types C_PTR and C_FUNPTR have the BIND attribute? This affects whether an object of one of these types is permitted directly in COMMON. C5101 in the Fortran 2008 standard states "If a common-block-object is of a derived type, it shall be a sequence type or a type with the BIND attribute and it shall have no default initialization." 2. Whether the derived types C_PTR and C_FUNPTR have the BIND attribute affects whether they are extensible. Subclause 4.5.7.1 of the Fortran 2008 standard states "A nonsequence derived type that does not have the BIND attribute is an extensible type." Are these types extensible? 3. Subclause 15.3.3 of the Fortran 2008 standard states that C_PTR and C_FUNPTR are derived types with private components. Are user-defined derived types with the BIND attribute permitted to have private components? ANSWER: 1. No, these types do not have the BIND(C) attribute. 15.3.3 does not specify that they have the BIND(C) attribute. 15.3.4 does not require them to have the BIND attribute in order to make them interoperable. 15.3.5 would require them to interoperate with a C struct if they had the BIND(C) attribute; this is absurd, since C object pointers and C function pointers are clearly not structs. Note that whether these types have default initialization is not specified by the standard, so possession of BIND(C) would not necessarily have allowed them in COMMON anyway. 2. No, these types were not intended to be extensible. It was an oversight that these types were not explicitly excluded from being extensible by subclause 4.5.7.1 paragraph 1 of the Fortran 2008 standard. An edit is provided to correct this. 3. Yes, a user-defined derived type with the BIND attribute is permitted to have private components. EDITS to 10-007r1: [10-007r1:4.5.7.1p1 77:3] Insert ", other than the type C_PTR or C_FUNPTR from the intrinsic module ISO_C_BINDING," after "A derived type". SUBMITTED BY: John Reid HISTORY: 05-151 m171 F03/0053 submitted - Passed by J3 meeting 05-170 m172 Passed J3 letter ballot #11 N1622 m172 Failed WG5 ballot N1629 11-217r1 m195 Revised answer for Fortran 2008 - Passed by J3 meeting ---------------------------------------------------------------------- NUMBER: F03/0065 TITLE: Relational equivalence KEYWORDS: Relational equivalence DEFECT TYPE: Interpretation STATUS: Passed by J3 meeting QUESTION: Given REAL X X = ... some value ... may IF( X+3.0 .EQ. 3.0 )... be transformed into IF( X .EQ. 0.0 )... by the processor? In Fortran 2003, 7.1.8.5 Evaluation of relational intrinsic operations says "Two relational intrinsic operations are relationally equivalent if their logical values are equal for all possible values of their primaries." On a machine where addition of 3.0 to a small value is not exact, the logical values for X+3.0==3.0 are not the same as X==0.0 for all possible values of X, therefore it would seem that this transformation would not be possible. However, Note 7.22 in Fortran 2003 shows this transformation as being acceptable. ANSWER: No, the transformation is not permitted unless it gives the same answer for all possible values (of X and X+3.0). The erroneous example has been removed in Fortran 2008. EDITS to 10-007r1: None. SUBMITTED BY: Fred Tydeman HISTORY: 05-192 m173 F03/0065 submitted 09-150 m187 Passed by J3 meeting 09-187r2 m188 Failed J3 letter ballot #18 09-155 11-222 m195 Revised answer - Passed by J3 meeting ---------------------------------------------------------------------- NUMBER: F03/0084 TITLE: IEEE_SET_ROUNDING_MODE in a subroutine KEYWORDS: IEEE_ARITHMETIC DEFECT TYPE: Interpretation STATUS: Passed by J3 meeting QUESTION: Section 7.1.7 of the Fortran 2008 standard says that if the value of an expression can be determined before execution of the program, it is standard-conforming to use the predetermined value. Consider the subprogram SUBROUTINE S() USE, INTRINSIC :: IEEE_ARITHMETIC USE, INTRINSIC :: IEEE_FEATURES INTEGER, PARAMETER :: sp = IEEE_SELECTED_REAL_KIND(6,30) real(sp) :: X = 0.5559013_sp real(sp) :: Y = 1.2092481_sp real(sp) :: Z1, Z2 IF (IEEE_SUPPORT_ROUNDING(IEEE_NEAREST,X) .AND. & IEEE_SUPPORT_ROUNDING(IEEE_UP,X)) THEN Z1 = X*Y CALL IEEE_SET_ROUNDING_MODE(IEEE_NEAREST) Z2 = X*Y PRINT *, 'Residual: ', Z1 - Z2 ENDIF END (1) Is a processor permitted always to print zero for the residual Z1 - Z2 ? (2) Same question, after giving X and Y the PARAMETER attribute. ANSWER: (1) Yes. The processor is allowed to evaluate constant expressions in any mathematically equivalent way. In particular, it is permitted to evaluate using higher precision than any precision available when the program is executed. For example, it might compute Z1 == Z2 == 0.67222259081253, then compute Z1 - Z2 == 0.0, regardless of how the program might do rounding at the seventh decimal digit when it is executed. (2) Yes, for the same reasons as question (1). EDITS to 10-007r1: None. SUBMITTED BY: Michael Ingrassia HISTORY: 06-372 m178 F03/0084 submitted 11-218 m195 Revised answer for Fortran 2008 - Passed by J3 meeting ---------------------------------------------------------------------- NUMBER: F03/0103 TITLE: Restrictions on dummy arguments not present for polymorphic type or parameterized derived type KEYWORDS: dummy argument, present, polymorphic, parameterized derived type DEFECT TYPE: Erratum STATUS: Passed by J3 meeting QUESTION: Consider Type t Real x End Type ... Subroutine s(x) Class(t),Optional :: x If (.Not.Present(x)) Call s2(x) End Subroutine Subroutine s2(y) Type(t),Optional :: y If (Present(y)) Print *,y End Subroutine Q1. Is the reference to s2, passing a polymorphic optional argument that is not present to a non-polymorphic optional dummy, standard conforming? Consider Type pdt(n) Integer,Length :: n Real x(n) End Type ... Subroutine s3(y) Type(pdt(*)),Optional :: y If (.Not.Present(y)) Call s4(y) End Subroutine Subroutine s4(z) Type(pdt(10)),Optional :: z If (Present(z)) Print *,z%x End Subroutine Q2. Is the reference to s4, passing an optional dummy argument with an assumed type parameter to an optional dummy argument with a non- assumed type parameter, standard conforming? Note that 12.5.2.4 paragraph 3 requires the length type parameter values to be the same (with no mention of argument presence). One might conjecture that these should not be conforming because the argument passing conventions between s and s2, and between s3 and s4, might be different (descriptor vs. reference). DISCUSSION: This does not seem to be limited to derived types, for example: Subroutine s3(y) Character(*),Optional :: y If (.Not.Present(y)) Call s4(y) End Subroutine Subroutine s4(z) Character(10),Optional :: z If (Present(z)) Print *,z End Subroutine ? ANSWER: These were all intended to be standard-conforming. An edit is supplied to correct the type parameter matching requirements. EDITS to 10-007r1: [293:6] 12.5.2.4, beginning of paragraph 3, insert new sentence "The kind type parameter values of the actual argument shall agree with the corresponding ones of the dummy argument." and change "The type parameter values of the actual argument" to "The length type parameter values of a present actual argument". [293:10] 12.5.2.4, paragraph 4, before "scalar" insert "present". SUBMITTED BY: Jim Xia HISTORY: 07-298r1 m182 F03/0103 submitted 07-298r2 m182 Passed by J3 meeting 08-133r2 m183 Failed J3 letter ballot #15 08-101 11-223 m195 Revised answer - Passed by J3 meeting ---------------------------------------------------------------------- NUMBER: F03/0116 TITLE: indistinguishable specifics for a generic interface with use association KEYWORDS: GENERIC RESOLUTION USE ASSOCIATION DEFECT TYPE: Interpretation STATUS: Passed by J3 meeting Consider the following program MODULE M1 INTERFACE SUBR MODULE PROCEDURE SUBR1 END INTERFACE CONTAINS SUBROUTINE SUBR1 END SUBROUTINE END MODULE M2 INTERFACE SUBR MODULE PROCEDURE SUBR2 END INTERFACE CONTAINS SUBROUTINE SUBR2 END SUBROUTINE END PROGRAM MAIN USE M1 CALL S CONTAINS SUBROUTINE S USE M2 CALL SUBR END SUBROUTINE END Is this program standard conforming? ANSWER: Subclause 12.4.3.4.5 of the Fortran 2008 standard forbids the presence of such conflicting interfaces. The rules in subclause 12.5.5.2 would be able to resolve the reference to SUBR in the example, but this fact does not negate the prohibition in subclause 12.4.3.4.5. EDITS to 10-007r1: None. SUBMITTED BY: Robert Corbett and Michael Ingrassia HISTORY: 08-169 m184 F03/0116 submitted 11-219r1 m195 Revised answer - Passed by J3 meeting ---------------------------------------------------------------------- NUMBER: F03/0118 TITLE: Are lower bounds of assumed-shape arrays assumed? KEYWORDS: LBOUND, assumed-shape array, constant expression DEFECT TYPE: Erratum STATUS: Passed by J3 meeting QUESTION: Does the following program conform to the 2008 Fortran standard? subroutine S ( A ) integer :: A(:,3:) integer, parameter :: R = size(lbound(A)) end subroutine S Processors disagree. If the lower bounds of an assumed-shape array are assumed, LBOUND(A) is not a constant expression according to item (4)(b)(i) in subclause 7.1.2. If the lower bounds of an assumed-shape array are not assumed, LBOUND(A) is a constant expression in this case, but might be a specification expression in other cases. ANSWER: This program conforms to the 2008 Fortran standard. The lower bounds of an assumed-shape array are not assumed. If a lower bound is not specified, it has the value 1 -- see the final sentence of the final paragraph of subclause 5.3.8.3. If a lower bound is specified, it must be specified either by a constant expression or a specification expression. In the example in the question, the lower bound of the first dimension is omitted, and therefore has the value 1, while the lower bound of the second dimension is given by a constant expression. Therefore, the reference to LBOUND is a constant expression, and thus the reference to SIZE is a constant expression. EDITS to 10-007r1: None. SUBMITTED BY: Van Snyder HISTORY: 08-200r1 m185 F03/0118 submitted 11-215 m195 Revised for F08 - Passed by J3 meeting --------------------------------------------------------------------- NUMBER: F03/0120 TITLE: When are parameterized sequence types the same type? KEYWORDS: type parameter, sequence type DEFECT TYPE: Erratum STATUS: Passed by J3 meeting QUESTION: (1) What does 4.5.2.4 mean by the phrase "have type parameters and components that agree in order, name, and attributes?" Does REAL A(2*N) "agree" with REAL A(N+N) ? Does REAL A(N*N) "agree" with REAL A(N**2) ? (2) How complicated can the expressions a processor must determine are equal or different be? DISCUSSION: The Fortran 2008 standard allows sequence types to have type parameters (4.5.2, 4.5.2.3). The Fortran 2008 standard also gives rules for deciding when two entities declared with reference to derived-type definitions have the same type (4.5.2.4). Those rules break down for parameterized sequence types. Although the Fortran 2008 standard does not explicitly say it, the standard assumes that two attributes that include one or more expressions agree only if the values of those expressions are the same. Previous standards used attributes with expressions that could not be evaluated statically only in contexts where the processor was not required to determine if those attributes agreed. The inclusion of parameterized sequence types has created situations where it is necessary for the processor to determine if such attributes agree. QUESTION: (3) Consider the modules MODULE M1 TYPE T(N) INTEGER(KIND=4), KIND :: N SEQUENCE REAL A(2*N) END TYPE TYPE(T(4)) :: X END MODULE M2 TYPE T(N) INTEGER(KIND=4), KIND :: N SEQUENCE REAL A(N+N) END TYPE TYPE(T(4)) :: Y END Are the variables X and Y in this example of the same type? (4) What if the two instances of the type parameter N in the previous example were not kind type parameters? (5) Consider the modules MODULE M1 INTERFACE S SUBROUTINE S1(X, M) TYPE T(N) INTEGER :: N SEQUENCE REAL A(N+N) END TYPE TYPE(T(M)) :: X END SUBROUTINE END INTERFACE TYPE T(N) INTEGER :: N SEQUENCE REAL A(N+N) END TYPE TYPE(T(2)) :: X END MODULE M2 INTERFACE S SUBROUTINE S2(X, M) TYPE T(N) INTEGER :: N SEQUENCE REAL A(2*N) END TYPE TYPE(T(M)) :: X END SUBROUTINE END INTERFACE TYPE T(N) INTEGER :: N SEQUENCE REAL A(2*N) END TYPE TYPE(T(2)) :: X END If these two modules are used in the same scoping unit and there is a CALL of the generic subroutine S in that scoping unit, does the Fortran 2008 standard require a conforming processor to detect and report the conflict with the rules given in 12.4.3.4.5? It seems it might or might not depending on one's interpretation of item (6) in 1.5. DISCUSSION: Some have suggested that two attributes that include expressions should be said to agree if and only if the corresponding expressions are equivalent. One problem with that notion is that in general the question of whether two expressions are equivalent is undecidable. That problem could be circumvented by restricting the forms of expressions allowed. For example, the expressions might be restricted to be polynomials of one or more variables. In that case, the problem of determining equivalence is merely intractable, not impossible. Some have suggested that the notion of requiring only that the values agree should be maintained. One consequence of that would be that some constraint violations that are can currently be detected statically could only be detected dynamically. For example, consider the program MODULE M1 TYPE T(N) INTEGER(KIND=4) :: N SEQUENCE REAL A(N+N) END TYPE END MODULE M2 TYPE T(N) INTEGER(KIND=4) :: N SEQUENCE REAL A(N*N) END TYPE END SUBROUTINE S(N) USE M1, T1=>T USE M2, T2=>T TYPE(T(N)) :: X TYPE(T(N)) :: Y Y%A = 0.0 X = Y END PROGRAM MAIN READ *, N CALL S(N) END Under the interpretation requiring equal values, the question of whether the processor must detect and report a constraint violation in the assignment X = Y cannot be determined until the value of N is known. Another suggestion was that attributes that include expressions agree if and only if they are textually equivalent. That opens up the question of what it means to say that two expressions are textually equivalent. Does whitespace count? Is "2" textually equivalent to "02"? It "2" textually equivalent to a named constant "TWO" whose value is two? Another suggestion was that two entities declared with reference to derived-type definitions in different scoping units should be considered to be of different if either or both of the derived-type definitions include type parameters. At least that solution is easy to specify. Parameterized sequence types add so little value to the Fortran language that they cannot be worth the trouble they cause for the language specification, for implementors, and, if there are any users, for users. Therefore, I suggest banning parameterized sequence types from the language. Implementations that currently support parameterized sequence types can continue to support them due to the permissive nature of the Fortran standard. ANSWER: It was not intended that parameterized derived types participate in the algorithm for determining when two types are the same, as given in section 4.5.2.4. Therefore the answers to the questions are: Not Applicable, Not Applicable, No, Still No, and No. To make this effective, edits are supplied which ban parameterized sequence types from the language. EDITS to 10-007r1: Replace constraint C436 on line 19 of page 62 with C436 (R425) If SEQUENCE appears, each data component shall be declared to be of an intrinsic type or of a sequence type, the derived-type shall not have type parameters and a type-bound-procedure-part shall not appear. Delete the phrase "type parameters and" from line 9 of page 63. SUBMITTED BY: Robert Corbett HISTORY: 08-261 m185 F03/0120 submitted 11-224 m195 Revised answer - Passed by J3 meeting --------------------------------------------------------------------- NUMBER: F08/0055 TITLE: G editing for reals KEYWORDS: format, G editing DEFECT TYPE: Erratum STATUS: Passed by J3 meeting QUESTION: Q1. Gw.d editing for a real value that is in the range (0.1,10**d) and is not near an integer power of 10 uses F editing to produce exactly a value with d significant digits. For values in this range that are near an integer power of 10, is it intended that F editing be used to produce a value with d significant digits? The rules in 10.7.5.2.2 usually have this effect, but the following examples illustrate exceptions for rounding UP and to ZERO. print "(ru,g11.2)", -9.95 print "(rz,g11.2)", -9.95 When rounded to two significant digits these are both equal to -9.9, however following through the rules in the standard it says to use F7.0 format which will give the result -9. (only one significant digit). For positive values, rounding DOWN and to ZERO print "(rd,g11.2)", 9.95 print "(rz,g11.2)", 9.95 both give the result 9.9 according to the rules in the standard. Q2. Is Gw.d editing intended to use F editing when that produces d significant digits? It usually achieves this, but for print "(ru,0p,g11.2)", -99.5 the standard requires 0PE11.2 editing to be used, which gives -0.99E+02 even though F7.2 editing can represent it as -99. Similarly for print "(ru,0p,g11.2)", 99. the standard requires 0PE11.2 editing to be used, which gives 0.99E+02, even though it is representable in F7.2 format as 99. Q3. COMPATIBLE and NEAREST modes of rounding differ only when the two nearest representable values are equidistant from the given value. The similarity appears not to be represented in the second table. What is meant by "if the higher value is even"? If by "even" we mean the last digit is even, then since we are talking about a mantissa which is close to 10, COMPATIBLE and NEAREST would have the same effect. Q4. The table has no entry for PROCESSOR_DEFINED rounding; since there is no value specified for r, it is impossible to interpret the table, which seems to indicate that it would not be standard conforming to use G editing with PROCESSOR_DEFINED. How does the PROCESSOR_DEFINED I/O rounding mode affect G editing? Q5. According to 10.7.2.3.7 paragraphs 3 and 4, the effect of NEAREST is processor dependent unless IEEE rounding on conversions is supported. How does this affect G editing? Q6. Consider PRINT '(5(1X,1PG9.0))', 0.0, 0.04, 0.06, 0.4, 0.6 noting that these values are strictly monotonic increasing. The standard appears to say that the output should be 0.E+00 4.E-02 0. 0. 6.E-01 which is decidedly not monotonic increasing. Is this intentional? ANSWER: A1. Yes, it is intended to produce output with d significant digits. The algorithm for choosing the output form for some I/O rounding modes is defective. An edit is provided to replace this algorithm. A2. Yes. This is solved by the same edit. A3. This question is rendered moot by the same edit. A4. This question is rendered moot by the same edit. A5. This question is rendered moot by the same edit. A6. No. An edit is supplied to fix this. EDITS to 10-007r1: [24:11+] In 1.6.2, insert new paragraph following paragraph 1: "The form produced by the G edit descriptor for some values and some I/O rounding modes differs from that specified by Fortran 2003." [24:27+] In 1.6.3, append new bullet item "- The form produced by the G edit descriptor with d==0 differs from that specified by Fortran 95 for some values.". [25:6] In 1.6.4, replace the last full stop with semicolon and insert new bullet item "- the G edit descriptor with d==0 for some values.". [258:14-] Insert new paragraph "If \si{d} is zero, \si{k}PE\si{w}.0 or \si{k}PE\si{w}.0E\si{e} editing is used for G\si{w}.0 editing or G\si{w}.0E\si{e} editing respectively." {Without the italics markup, this is "If d is zero, kPEw.0 or kPEw.0Ee editing is used for Gw.0 editing or Gw.0Ee editing respectively."} [258:15-19] Replace the second and subsequent sentences of paragraph 4 including the two internal pseudo-tables by "Let \it{N} be the decimal value resulting from the conversion of the internal value to decimal and its subsequent rounding to \si{d} significant digits according to the I/O rounding mode, and let \it{s} be the decimal exponent value of \it{N}, or 1 if \it{N} is equal to zero. If 0<=\it{s}<=\si{d}, F(\si{w}-\it{n}).(\si{d}-\it{s}),n('b') editing is used where \it{b} is a blank and \it{n} is 4 for G\si{w}.\si{d} editing and \si{e}+2 for G\si{w}.\si{d}E\si{e} editing. If \it{s}<0 or \it{s}>d, \si{k}PE\si{w}.\si{d} or \si{k}PE\si{w}.\si{d}E\si{e} editing is used for G\si{w}.\si{d} editing or G\si{w}.\si{d}E\si{e} editing respectively." {Note: \it{something} is something in italics, \si{something} is a syntax term (in italics). Without the italics markup, this is "Let N be the decimal value resulting from the conversion of the internal value to decimal and its subsequent rounding to d significant digits according to the I/O rounding mode, and let s be the decimal exponent value of N, or 1 if N is equal to zero. If 0<=s<=d, F(w-n).(d-s),n('b') editing is used where b is a blank and n is 4 for Gw.d editing and e+2 for Gw.dEe editing. If s<0 or s>d, kPEw.d or kPEw.dEe editing is used for Gw.d editing or Gw.dEe editing respectively."} SUBMITTED BY: John Reid and Thomas Henlich HISTORY: 11-174 m195 F08/0055 submitted 11-174r2 Revised answer - Passed by J3 meeting ------------------------------------------------------------------------ NUMBER: F08/0056 TITLE: Non-polymorphic ALLOCATE with polymorphic SOURCE= KEYWORDS: ALLOCATE, polymorphic, SOURCE=. DEFECT TYPE: Erratum STATUS: Passed by J3 meeting QUESTION: Consider Program m195_m1 Type t Real c End Type Type,Extends(t) :: t2 Real d End Type Class(t),Allocatable :: x Type(t),Allocatable :: y Allocate(x,Source=t2(1.5,-1.5)) Allocate(y,Source=x) ! (*) ... End Program Is the second ALLOCATE statement (marked *) standard-conforming? The only requirement is that Y be type-compatible with X; they both have the same declared type so this is true. However, the very similar Allocate(y,Source=t2(1.2,-1.5)) would not be conforming because Y is not type-compatible with the structure constructor, and y = x would also not be conforming (the dynamic types being different). However, the standard says that "the value of [y] becomes that of [x]" which is clearly impossible. Since the standard fails to establish an interpretation one might conclude that the example is not conforming. However, the similar situation with the dynamic types being the same but with non-deferred length type parameters being different is explicitly stated to be conforming (and to raise an error condition), perhaps this was also intended to raise an error condition. It is also possible that the intent was to use the value of the declared type part in this case, as happens for pointer assignment. What is the interpretation of this ALLOCATE statement? ANSWER: The statement was intended to be conforming and to use the declared type part of the source-expr only. An edit is supplied to clarify. EDITS to 10-007r1: [128:24] In 6.7.1.2p7, before "On successful", insert "If an is not polymorphic and the is polymorphic with a dynamic type that differs from its declared type, the value provided for that is the ancestor component of the that has the type of the ; otherwise, the value provided is the value of the ." [128:25-26] Replace "that of " with "the value provided", twice. SUBMITTED BY: Malcolm Cohen HISTORY: 11-194 m195 F08/0056 submitted 11-194r1 Revised answer - Passed by J3 meeting ---------------------------------------------------------------------- NUMBER: F08/0057 TITLE: Interoperability with empty types KEYWORDS: Interoperability, derived type DEFECT TYPE: Erratum STATUS: Passed by J3 meeting QUESTION: Consider TYPE,BIND(C) :: t END TYPE This is apparently standard-conforming, and interoperates with struct t { }; However, the latter is not valid syntax according to the C standard. How can a type be interoperable with a syntax error? ANSWER: The type definition was not intended to be standard-conforming. An edit is supplied to correct this error. EDITS to 10-007r1: [431:12+] In 15.3.4, insert new constraint after C1505 "C1505a (R425) A derived type with the BIND attribute shall have at least one component." SUBMITTED BY: Malcolm Cohen HISTORY: 11-195 m195 F08/0057 submitted - Passed by J3 meeting ---------------------------------------------------------------------- NUMBER: F08/0058 TITLE: ENTRY point RESULT variable KEYWORDS: ENTRY, RESULT DEFECT TYPE: Erratum STATUS: Passed by J3 meeting QUESTION: MODULE m REAL x CONTAINS FUNCTION f() f = 1 x = 2 RETURN ENTRY e() RESULT(x) x = 3 END FUNCTION END MODULE Is this standard-conforming? If so, what is the result of referencing f() and e(), and what effect does that have on the module variable x? Note that the standard prohibits dummy arguments of an entry point from appearing in executable statements ahead of the ENTRY statement (unless they are also dummy arguments of an earlier ENTRY statement or the FUNCTION statement), but makes no similar requirement on the RESULT name. ANSWER: This program was not meant to be conforming. An edit is provided to correct this mistake in the standard. EDITS to 10-007r1: Append new statement to 12.6.2.6p8 [310:20], "A name that appears as a in an ENTRY statement shall not appear in any executable statement that precedes the first RESULT clause with that name." Append new statement to 12.6.2.6p9 [310:23] "A name that appears as a in an ENTRY statement shall not appear in the expression of a statement function that precedes the first RESULT clause with that name unless the name is also a dummy argument of that statement function." SUBMITTED BY: Malcolm Cohen HISTORY: 11-196 m195 F08/0058 submitted 11-196r1 Revised edits - Passed by J3 meeting ---------------------------------------------------------------------- NUMBER: F08/0059 TITLE: Auto-targetting requirements KEYWORDS: POINTER, TARGET, argument association DEFECT TYPE: Erratum STATUS: Passed by J3 meeting QUESTION: Consider PROGRAM one REAL,TARGET :: x = 0 CLASS(*),POINTER :: p p => x ! (0). CALL s(p) ! (1). CALL s(x) ! (2). PRINT *,x CONTAINS SUBROUTINE s(q) CLASS(*),INTENT(IN),POINTER :: q IF (ASSOCIATED(q)) THEN SELECT TYPE (q) TYPE IS (REAL) q = q + 1 END SELECT END IF END SUBROUTINE END PROGRAM Clearly everything except statement (2) is standard-conforming. The statement marked (2) violates the requirement in 12.5.2.5 paragraph 2 for the actual argument to be polymorphic when the dummy argument is a polymorphic pointer. However, apart from that requirement, statement (2) is functionally equivalent to the sequence (0) then (1), so the "auto-targetting" feature does not need this requirement. Was this imposition of this requirement (which is needed when both the actual and the dummy are pointers) an oversight in this case? Note that similar considerations apply to CHARACTER(100),TARGET :: actual CHARACTER(:),POINTER,INTENT(IN) :: dummy in that the pointer assignment would be valid, but the requirements in 12.5.2.5 paragraph 5 are not met. ANSWER: Yes, the imposition of these requirements to the auto-targetting feature was an oversight. An edit is supplied to correct this. EDITS to 10-007r1: [295:16-17] In 12.5.2.5, Replace paragraph with "The requirements in this subclause apply to an actual argument with the ALLOCATABLE or POINTER attribute and that corresponds to a dummy argument with the same attribute." {Except for paragraph 4, all these requirements are unnecessary when auto-targetting is happening. Note that 12.5.2.5p6 is moot because a coindexed object is not permitted in auto-targetting as it is not a valid target in a pointer assignment (C725).} [296:4-5] Delete paragraph 12.5.2.5p4 and reinsert twice, once at [296:12+] as a new paragraph after 12.5.2.6p3, and once at [296:35] as a new sentence at the end of 12.5.2.7p3. {Duplicate the bit about assumed type parameters.} SUBMITTED BY: Malcolm Cohen HISTORY: 11-197 m195 F08/0059 submitted 11-197r1 m195 Revised editing instructions - Passed by J3 meeting ---------------------------------------------------------------------- NUMBER: F08/0060 TITLE: Procedure pointer assignment with an EXTERNAL target KEYWORDS: Procedure pointer, pointer assignment, EXTERNAL attribute DEFECT TYPE: Erratum STATUS: Passed by J3 meeting QUESTION: Consider Program m5 Print *,f() Call s Contains Subroutine s Procedure(Real),Pointer :: p Print *,g() p => f ! (1) Print *,p() p => g ! (2) Print *,p() End Subroutine End Program Function f() f = 1 End Function Function g() g = 2 End Function is this program standard-conforming? On the face of it, both (1) and (2) violate constraint C729, which only allows an external procedure "that is accessed by use or host association and is referenced in the scoping unit as a procedure or that has the EXTERNAL attribute". The function f is accessed by host association but is not referenced in the scoping unit as a procedure, whereas the function g is referenced in the scoping unit as a procedure but is not accessed by use or host association. Furthermore, consider Program m5a Real,External :: f,p Pointer p p => f ! (3) Print *,p() End Program ! function f as above. Is this conforming? The constraint has a single clause for external procedures with no commas but with a disjunction and a conjunction, therefore it is ambiguous whether it means "accessed by use or host association" AND ("is referenced in the scoping unit as a procedure" OR "has the external attribute") or whether it means ("accessed by use or host association" AND "is referenced in the scoping unit as a procedure") OR "has the external attribute") Since the standard does not unambiguously give an interpretation of this program it seems that statement (3) is also not conforming. Which of these three procedure pointer assignment statements were intended to be conforming? DISCUSSION: The wording of this constraint was determined by Interp F03/0138, which intended to change it to "C727 (R742) A shall be the name of a module or dummy procedure, a specific intrinsic function listed in 13.6 and not marked with a bullet ($\bullet$), a procedure pointer, or an external procedure that is accessed by use or host association, referenced in the scoping unit as a procedure, or that has the EXTERNAL attribute." but a last-minute "editorial" change at the WG5 ballot stage made it "C727 (R742) A shall be the name of a module or dummy procedure, a specific intrinsic function listed in 13.6 and not marked with a bullet ($\bullet$), a procedure pointer, or an external procedure that is accessed by use or host association and is referenced in the scoping unit as a procedure, or that has the EXTERNAL attribute." instead, and the comma got lost in between there and Fortran 2008. Despite supposedly being an editorial change, the WG5 wording has different technical results. According to the original wording of the interp, all three examples above were intended to be allowed. ANSWER: All three pointer assignment statements were intended to be valid. An edit is supplied to correct the error in the standard. EDITS to 10-007r1: [158:33-159:2] In 7.2.2.2, C729, replace "an external ... bullet ($\bullet$)" with "a specific intrinsic function listed in 13.6 and not marked with a bullet ($\bullet$), or an external procedure that is accessed by use or host association, referenced in the scoping unit as a procedure, or that has the EXTERNAL attribute". {NB: $\bullet$ is the LaTeX command that produces a bullet.} SUBMITTED BY: Malcolm Cohen HISTORY: 11-198 m195 F08/0060 submitted - Passed by J3 meeting ---------------------------------------------------------------------- NUMBER: F08/0061 TITLE: Description of the CONTIGUOUS attribute misworded? KEYWORDS: CONTIGUOUS DEFECT TYPE: Erratum STATUS: Passed by J3 meeting Consider the following code: module mod_cont contains subroutine fcont(x) real, contiguous :: x(:) integer :: i x = (/ (real(i),i=1,size(x)) /) end subroutine fcont end module mod_cont program cont use mod_cont implicit none real :: x(45) call fcont(x(1::3)) end program Is this program standard conforming? 5.3.7 paragraph 1 says: "The CONTIGUOUS attribute specifies that an assumed-shape array can only be argument associated with a contiguous effective argument, or that an array pointer can only be pointer associated with a contiguous target." ANSWER: Yes. The effect of the CONTIGUOUS attribute is misstated. An edit is supplied to correct this. EDITS for 10-007r1: [93:7-8] In 5.3.7p1, Change "can only be argument associated with a contiguous effective argument" to "is contiguous". ADDITIONAL SUGGESTED EDIT FOR A FUTURE REVISION: [93:30+] In 5.3.7 after Note 5.10, insert additional note "NOTE 5.10a If an actual argument is not simply contiguous and the corresponding dummy argument is an assumed-shape array with the CONTIGUOUS attribute, the processor might use the so-called copy-in/copy-out argument passing mechanism to assure the contiguity of the dummy argument." SUBMITTED BY: Reinhold Bader HISTORY: 11-199r1 m195 F08/0061 submitted 11-199r1 m195 Revised edits 11-199r2 m195 Revised edits - Passed by J3 meeting ---------------------------------------------------------------------- NUMBER: F08/0062 TITLE: Mixing default initialization with DATA initialization KEYWORDS: DATA, default initialization, explicit initalization DEFECT TYPE: Clarification STATUS: Passed by J3 meeting QUESTION: In the following program, one component has a default initialization and the other is initialized in a DATA statement. Is the program valid? module oad_active implicit none type active integer :: v integer :: d = 42 end type end module module tots_c use oad_active implicit none type(active), save :: trlkold data trlkold%v /100/ end module program foo use tots_c implicit none if (trlkold%d /= 42) stop 'ERROR d /= 42' if (trlkold%v /= 100) stop 'ERROR v /= 100' end program foo WG5/N1830 has [p104, 5.4.7, parag. 2] If a nonpointer object has default initialization, it shall not appear in a . and [p89, 5.2.3, parag. 1] Explicit initialization alternatively may be specified in a DATA statement unless the variable is of a derived type for which default initialization is specified. [...] A variable, or part of a variable, shall not be explicitly initialized more than once in a program. and [p70, 4.5.4.6, parag. 6] Explicit initialization in a type declaration statement (5.2) overrides default initialization ANSWER: It was intended that the data statement not be conforming. 5.4.7p2 was carefully worded to use "shall not appear" rather than "shall not be the ". The intention was that an object be initialized entirely in a type declaration statement, or that only those parts of it having default initialization be initialized. It was considered to be a burden on processors to be required to initialize some parts of a structure using default initialization, and other parts of it explicitly. EDITS to 10-007r1: None. SUBMITTED BY: Tobias Burnus HISTORY: 11-201 m195 F08/0062 submitted 11-201r1 m195 Draft answer - Passed by J3 meeting ----------------------------------------------------------------------