Author: dgilmore
Date: 2010-11-17 17:18:43 -0500 (Wed, 17 Nov 2010)
New Revision: 3403
Modified:
trunk/osprey/crayf90/fe90/cf95.msgs
trunk/osprey/crayf90/fe90/s_call.c
trunk/osprey/crayf90/fe90/s_call.h
trunk/osprey/crayf90/fe90/s_interoperable.c
trunk/osprey/crayf90/fe90/s_intrin.c
Log:
Fixed bug 668 - Cleanup of string handling in F90 front-end.
Ported fixes from PSC 3.3 beta.
Reviewed and approved by Michael Lai.
Modified: trunk/osprey/crayf90/fe90/cf95.msgs
===================================================================
--- trunk/osprey/crayf90/fe90/cf95.msgs 2010-11-17 01:07:18 UTC (rev 3402)
+++ trunk/osprey/crayf90/fe90/cf95.msgs 2010-11-17 22:18:43 UTC (rev 3403)
@@ -1,6 +1,8 @@
$
-$ Copyright (C) 2006. QLogic Corporation. All Rights Reserved.
+$ Copyright (C) 2007, 2008. PathScale, LLC. All Rights Reserved.
$
+$ Copyright (C) 2006, 2007. QLogic Corporation. All Rights Reserved.
+$
$ Copyright 2003, 2004, 2005, 2006 PathScale, Inc. All Rights Reserved.
$
$ Copyright (C) 2000, 2001 Silicon Graphics, Inc. All Rights Reserved.
@@ -2839,12 +2841,13 @@
.ME
$
$ Error : 0202
-$msg 0202 The status variable for this ALLOCATE/DEALLOCATE statement must be
a scalar integer variable.
+$msg 0202 The status variable for this ALLOCATE/DEALLOCATE statement must be
scalar and integer, not constant or protected.
$nexp 0202
-Error : The status variable for this ALLOCATE/DEALLOCATE statement must be a
scalar integer variable.
+Error : The status variable for this ALLOCATE/DEALLOCATE statement must be
scalar and integer, not constant or protected.
.PP
The variable used as the status variable, \*CSTAT = \fIstat_variable\fR, in an
\*CALLOCATE\fR or \*CDEALLOCATE\fR
-statement cannot be an array and must be of integer type.
+statement cannot be an array, must be of integer type, must not be a constant,
+and must not be use-associated if it is protected.
.ME
$
$ Error : 0203
@@ -4562,12 +4565,13 @@
.ME
$
$ Error : 0326
-$msg 0326 The left hand side of this assignment statement is a constant.
+$msg 0326 The left hand side of this assignment statement is constant or
protected.
$nexp 0326
-Error : The left hand side of this assignment statement is a constant.
+Error : The left hand side of this assignment statement is constant or
protected.
.PP
-The left side of an assignment statement is either a named constant or a
-subobject of a named constant.
+The left side of an assignment statement is either a named constant, a
+a use-associated variable that is protected, or a subobject that is constant
+or protected.
.ME
$
$ Ansi : 0327
@@ -5671,12 +5675,14 @@
.ME
$
$ Error : 0418
-$msg 0418 The variable in a pointer assignment statement must have the TARGET
attribute or the POINTER attribute.
+$msg 0418 The right side of a pointer assignment must either have the POINTER
attribute, or have the TARGET attribute and not be protected.
$nexp 0418
-Error : The variable in a pointer assignment statement must have the TARGET
attribute or the POINTER attribute.
+Error : The right side of a pointer assignment must either have the POINTER
attribute, or have the TARGET attribute and not be protected.
.PP
-The variable that is the right side of a pointer assignment statement,
-must be a target, the subobject of a target, or a pointer.
+The variable that is the right side of a pointer assignment statement may be a
+pointer, or it may be a non-pointer variable. If the latter, it must have the
+TARGET attribute, and it must not be a use-associated variable with the
+PROTECTED attribute.
.ME
$
$ Error : 0419
@@ -6148,12 +6154,13 @@
.ME
$
$ Error : 0460
-$msg 0460 The %s control list specifier must have a scalar %s variable as an
argument for this %s statement.
+$msg 0460 The %s control list specifier must have a scalar %s variable, not
constant or protected, as an argument for this %s statement.
$nexp 0460
-Error : The %s control list specifier must have a scalar %s variable as an
argument for this %s statement.
+Error : The %s control list specifier must have a scalar %s variable, not
constant or protected, as an argument for this %s statement.
.PP
Some I/O control list specifiers require a variable name as an argument. It
-must be of the required type and must have default kind type.
+must be of the required type and must have default kind type. It must not be a
+constant or a use-associated protected variable.
.ME
$
$ Error : 0461
@@ -6320,11 +6327,11 @@
.ME
$
$ Error : 0479
-$msg 0479 A constant cannot be used as an input item in a %s statement.
+$msg 0479 A constant or protected variable cannot be used as an input item in
a %s statement.
$nexp 0479
-Error : A constant cannot be used as an input item in a %s statement.
+Error : A constant or protected variable cannot be used as an input item in a
%s statement.
.PP
-An I/O input item is a constant. Input items must be variables.
+An I/O input item must be a variable which is not use-associated and protected.
.ME
$
$ Warning : 0480
@@ -6341,7 +6348,7 @@
$nexp 0481
Error : This implied-DO control variable is not valid.
.PP
-An expression or constant appears where an implied-\*CDO\fR variable is
expected.
+An expression, constant, or use-associated protected variable appears where an
implied-\*CDO\fR variable is expected.
.ME
$
$ Error : 0482
@@ -6353,9 +6360,9 @@
.ME
$
$ Error : 0483
-$msg 0483 The IOLENGTH= specifier in an INQUIRE statement must be a scalar
default integer variable.
+$msg 0483 The IOLENGTH= specifier in an INQUIRE statement must be a scalar
default integer variable, not constant or protected.
$nexp 0483
-Error : The IOLENGTH= specifier in an INQUIRE statement must be a scalar
default integer variable.
+Error : The IOLENGTH= specifier in an INQUIRE statement must be a scalar
default integer variable, not constant or protected.
.PP
In an \*CINQUIRE\fR statement, the \*CIOLENGTH=\fR specifier requires that a
scalar integer variable of default kind type be specified.
@@ -15522,7 +15529,7 @@
.PP
An array reference was encountered where a subscript was out of bounds
for the array. The compiler will check array bounds at compile time if
--Rb is specified and the subscript and bounds values are constant. The
+-C is specified and the subscript and bounds values are constant. The
following code shows three cases where this message would be issued.
integer i(10)
@@ -16545,7 +16552,7 @@
A procedure other than a statement function shall have an explicit interface
if the procedure is elemental or the procedure has
- (a) An optional dummy argument
+ (a) An optional or volatile dummy argument
(b) A dummy argument that is an assumed-shape array, a pointer or a
target
(c) An array-valued result (functions only.)
@@ -20598,9 +20605,9 @@
.ME
$
$ Warning : 1602
-$msg 1602 Common block "%s" is used in multiple program units. It must be
specified with the %s directive in all uses.
+$msg 1602 Common block "%s" is used in multiple program units. It must be
specified with the %s directive in all uses: see line %s.
$nexp 1602
-Warning : Common block "%s" is used in multiple program units. It must be
specified with the %s directive in all uses.
+Warning : Common block "%s" is used in multiple program units. It must be
specified with %s in all uses: see line %s.
.PP
In this compilation, a common block is used in multiple program units. If
the common block is specified with a directive describing storage or how
@@ -20992,10 +20999,14 @@
.PP
An array reference was encountered where a subscript was out of bounds for
the array. The subscript could be either a single value, or a triplet
-section. The compiler will check array bounds at compile time if -Rb is
+section. The compiler will check array bounds at compile time if -C is
specified and the subscript and bounds values are constant. The BOUNDS
and NOBOUNDS compiler directives will control the issuing of this
-message for specific ranges of code or for specific variables.
+message for specific ranges of code or for specific variables. You can
+turn the compile-time warning into an error by setting the environment
+variable F90_BOUNDS_CHECK_ABORT to "YES" (which also changes run-time
+bounds check warnings into fatal errors.)
+.PP
The following code shows three cases where this message would be issued.
integer i(10)
@@ -21205,11 +21216,12 @@
.ME
$
$ Error : 1650
-$msg 1650 This argument cannot be a constant.
+$msg 1650 This argument cannot be a constant or protected variable.
$nexp 1650
-Error : This argument cannot be a constant.
+Error : This argument cannot be a constant or protected variable.
.PP
-This actual argument may not be a constant.
+This actual argument may not be a constant, and it may not be a use-associated
+variable with the PROTECTED attribute.
.ME
$
$ Error : 1651
@@ -21639,4 +21651,187 @@
an individual variable which is either a module variable or a variable having
the SAVE attribute which is not in a common block.
.ME
-$ LAST NUMBER USED : 1687
+$
+$ Error : 1688
+$msg 1688 Because dummy argument %s is volatile, this actual argument is not
allowed
+$nexp 1688
+Error : Because dummy argument %s is volatile, this actual argument is not
allowed
+.PP
+If a dummy argument is volatile, then:
+ 1. The actual argument may not be an array section using a vector subscript
+ 2. If the actual argument is a pointer, the dummy argument must be a pointer
+ or an assumed-shape array (Fortran 2003 constraint C1233)
+ 3. If the actual argument is an assumed-shape array or an array section
+ not using a vector subscript, the dummy argument must be an assumed-shape
+ array (Fortran 2003 constraint C1232)
+.ME
+$
+$ Error : 1689
+$msg 1689 BIND with NAME= cannot apply to more than one entity in statement
+$nexp 1689
+Error : BIND with NAME= cannot apply to more than one entity in statement
+.PP
+Fortran 2003 constraints C533 and C551 forbid multiple entities in a single
+statement if BIND specifies an explicit language binding label
+.ME
+$
+$ Error : 1690
+$msg 1690 NAME= specifier in BIND clause requires scalar character constant
+$nexp 1690
+Error : NAME= specifier in BIND clause requires scalar character constant
+.PP
+Fortran 2003 constraint C540 requires that the NAME= specifier in a
+language-binding-spec must provide a scalar character constant expression
+.ME
+$
+$ Error : 1691
+$msg 1691 For "%s", %s not allowed with BIND(C)
+$nexp 1691
+Error : For "%s", "%s" not allowed with BIND(C)
+.PP
+Various Fortran 2003 constraints limit the use of the language binding spec
+"BIND(C)":
+.PP
+ C530: Dummy argument must not have ALLOCATABLE, POINTER, or OPTIONAL
+ attribute
+ C532: Entity must be an interoperable variable or procedure
+ C550: Variable must be interoperable and appear in module specification
+ part
+ C1237: Procedure must not be internal
+ C1238: Procedure dummy argument must be nonoptional interoperable variable
+ or procedure; function result must be interoperable variable
+ C1242: Function must not be ELEMENTAL
+ C1501: Derived type must not have SEQUENCE
+ C1502: Derived type must not have type parameters
+ C1503: Derived type must not have EXTENDS attribute
+ C1504: Derived type must not have a type-bound procedure
+ C1505: Each component of derived type must be interoperable, and must not
+ have POINTER or ALLOCATABLE attribute
+.PP
+"Interoperable" means that an equivalent entity can be defined by means of C:
+generally, its type must be one of the types provided by the intrinsic module
+"ISO_C_BINDING", or a derived type which itself uses "BIND" and whose
+components are interoperable. ALLOCATABLE and POINTER variables are never
+interoperable. Only explicit-shape and assumed-size arrays can be
+interoperable. CHARACTER types can be arrays, but must have LEN=1.
+.ME
+$
+$ Error : 1692
+$msg 1692 Argument of intrinsic C_LOC or C_FUNLOC doesn't satisfy Fortran 2003
+$nexp 1692
+Error : Argument of intrinsic C_LOC or C_FUNLOC doesn't satisfy Fortran 2003
+.PP
+Fortran 2003 requires that the argument of ISO_C_BINDING module procedure C_LOC
+either have interoperable type and type parameters, or be a nonpolymorphic
+scalar with no length type parameters.
+.PP
+If it has an interoperable type, it must satisfy one of these requirements:
+ 1. It must be a variable with the TARGET attribute but without ALLOCATABLE
+ and POINTER, or
+ 2. It must be a variable with ALLOCATABLE and TARGET attributes which
+ is allocated and is not a zero-size array, or
+ 3. It must be a scalar with the POINTER attribute which is associated
+.PP
+Otherwise, it must either have the TARGET attribute or it must be a POINTER;
+if it is ALLOCATABLE, it must be allocated.
+.PP
+Fortran 2003 requires that the argument of C_FUNLOC be a procedure with the
+BIND attribute, or a procedure pointer associated with an interoperable target.
+.ME
+$
+$ Error : 1693
+$msg 1693 For "%s", type "%s" lacks the BIND attribute
+$nexp 1693
+Error : For "%s", type "%s" lacks the BIND attribute
+.PP
+To be interoperable with C, a structure must use a type which has the BIND
+attribute.
+.ME
+$
+$ Error : 1694
+$msg 1694 Cannot use BIND on "%s": not in specification part of module
+$nexp 1694
+Error : Cannot use BIND on "%s": not in specification part of module
+.PP
+Fortran 2003 constraint C550 prohibits the BIND attribute on a variable
+declaration outside the specification part of a module.
+.ME
+$
+$ Error : 1695
+$msg 1695 For "%s", BIND requires CHARACTER type to have LEN=1
+$nexp 1695
+Error : For "%s", BIND requires CHARACTER type to have LEN=1
+.PP
+The Fortran standard requires that
+a CHARACTER type used with BIND must have LEN=1, "*1", or default
+LEN in order to be interoperable with C. An array of CHARACTER(LEN=1) is
+allowed.
+.ME
+$
+$ Error : 1696
+$msg 1696 Applied BIND more than once to "%s" (identifier first appeared at
line %d)
+$nexp 1696
+Error : Applied BIND more than once to "%s" (identifier first appeared at
line %d)
+.PP
+The BIND attribute has been applied to the variable or common block more than
+once
+.ME
+$
+$ Ansi : 1697
+$msg 1697 Fortran 2003 feature: "%s" is both %s and %s (identifier first
appeared at line %d)
+$nexp 1697
+Ansi : Fortran 2003 feature: "%s" is both %s and %s (identifier first
appeared at line %d)
+.PP
+A dummy argument could not have both POINTER and "INTENT" attributes prior to
Fortran 2003.
+.ME
+$
+$ Error : 1698
+$msg 1698 Error in argument SHAPE of intrinsic C_F_POINTER
+$nexp 1698
+Error : Error in argument SHAPE of intrinsic C_F_POINTER
+.PP
+For intrinsic C_F_POINTER, if argument FPTR is not a pointer, then the optional
+argument SHAPE must not appear. Otherwise, SHAPE must be an array of rank 1
+whose size is equal to the rank of FPTR.
+.ME
+$
+$ Error : 1699
+$msg 1699 Dummy procedure %s needs BIND attribute to make %s interoperable
+$nexp 1699
+Error : Dummy procedure %s needs BIND attribute to make %s interoperable
+.PP
+If a procedure has the BIND attribute, and one of its dummy arguments is a
+dummy procedure, then the dummy procedure must also have the BIND attribute.
+.ME
+$
+$ Error : 1700
+$msg 1700 For "%s", binding label does not match the one ("%s") defined at
line %s
+$nexp 1700
+Error : For "%s", binding label does not match the one ("%s") defined at
line %s
+.PP
+The binding label specified (explicitly or implicitly) by the "BIND" attribute
+should be consistent.
+.ME
+$
+$ Warning : 1701
+$msg 1701 "%s" and "%s" have same external linker symbol "%s": see line %s
+$nexp 1701
+Warning : "%s" and "%s" have same external linker symbol "%s": see line %s
+.PP
+The same external linker symbol is being used for two different procedures or
common blocks, probably due to an error in a BIND clause.
+.ME
+$
+$ Error : 1702
+$msg 1702 Cannot change constant or PROTECTED entity "%s"
+$nexp 1702
+Error : Cannot change constant or PROTECTED entity "%s"
+.PP
+The value of a constant entity cannot be redefined.
+.PP
+The value of an entity with the PROTECTED attribute can be used but not defined
+outside the module which declares the entity. If the entity has the POINTER or
+ALLOCATABLE attribute, it cannot be allocated, deallocated, or nullified
outside
+the module either.
+.ME
+$ LAST NUMBER USED : 1702
+
Modified: trunk/osprey/crayf90/fe90/s_call.c
===================================================================
--- trunk/osprey/crayf90/fe90/s_call.c 2010-11-17 01:07:18 UTC (rev 3402)
+++ trunk/osprey/crayf90/fe90/s_call.c 2010-11-17 22:18:43 UTC (rev 3403)
@@ -1,9 +1,8 @@
/*
* Copyright (C) 2010 Advanced Micro Devices, Inc. All Rights Reserved.
*/
-
/*
- * Copyright (C) 2007, 2008. PathScale, LLC. All Rights Reserved.
+ * Copyright (C) 2007, 2008, 2009. PathScale, LLC. All Rights Reserved.
*/
/*
* Copyright (C) 2006, 2007. QLogic Corporation. All Rights Reserved.
@@ -2203,7 +2202,10 @@
# ifdef _DEBUG
if (ATD_FLD(attr_idx) != IR_Tbl_Idx) {
- PRINTMSG(line, 626, Internal, col,
+ /* Demoted this assertion, since we haven't seen a situation
+ * where it does not trigger.
+ */
+ PRINTMSG(line, 626, Dev_Warning, col,
"ATD_FLD(attr_idx) == IR_Tbl_Idx", "check_for_elementals");
}
# endif
@@ -2215,8 +2217,10 @@
if (IR_FLD_R(asg_idx) != IR_Tbl_Idx ||
IR_OPR(IR_IDX_R(asg_idx)) != Call_Opr ||
! ATP_ELEMENTAL(IR_IDX_L(IR_IDX_R(asg_idx)))) {
-
- PRINTMSG(line, 626, Internal, col,
+ /* Demoted this assertion, since we haven't seen a situation
+ * where it does not trigger.
+ */
+ PRINTMSG(line, 626, Dev_Warning, col,
"elemental function", "check_for_elementals");
}
# endif
@@ -13211,6 +13215,17 @@
same = FALSE;
}
else if (aa_rank == 0) { /* scalar to array */
+#ifdef KEY /* Bug 14150 */
+ linear_type_type actual_linear_type = (info_idx == NULL_IDX) ?
+ Err_Res :
+ arg_info_list[info_idx].ed.linear_type;
+ int atd_array_idx = ATD_ARRAY_IDX(arg_attr);
+ bd_array_type dummy_array_class = atd_array_idx ?
+ BD_ARRAY_CLASS(atd_array_idx) :
+ Unknown_Array;
+ linear_type_type dummy_linear_type =
+ TYP_TYPE(ATD_TYPE_IDX(arg_attr));
+#endif /* KEY Bug 14150 */
if (BD_ARRAY_CLASS(ATD_ARRAY_IDX(arg_attr)) ==
Assumed_Shape){
PRINTMSG(opnd_line, 434, Error, opnd_column,
@@ -13225,6 +13240,18 @@
/* have an expression. */
}
+#ifdef KEY /* Bug 14150 */
+ else if ((actual_linear_type == Character_1 ||
+ actual_linear_type == Short_Char_Const) &&
+ (dummy_array_class == Explicit_Shape ||
+ dummy_array_class == Assumed_Size) &&
+ dummy_linear_type == Character) {
+ /* F2003 section 12.4.1.5 rules of sequence association plus
+ * note 15.19 on passing strings to bind(c) say that a
+ * scalar character(n) actual is compatible with an
+ * explicit- or assumed-size array of type character. */
+ }
+#endif /* KEY Bug 14150 */
else {
PRINTMSG(opnd_line, 435, Error, opnd_column,
AT_OBJ_NAME_PTR(arg_attr));
Modified: trunk/osprey/crayf90/fe90/s_call.h
===================================================================
--- trunk/osprey/crayf90/fe90/s_call.h 2010-11-17 01:07:18 UTC (rev 3402)
+++ trunk/osprey/crayf90/fe90/s_call.h 2010-11-17 22:18:43 UTC (rev 3403)
@@ -263,7 +263,13 @@
/* Scalar_Constant */ {
/* Unknown_Dummy */ COPY_IN,
/* Scalar_Dummy */ COPY_IN,
+#ifdef KEY /* Bug 14150 */
+ /* F2003 allows passing a character string (which
+ * may be const) to a dummy array of character */
+ /* Sequence_Array_Dummy */ COPY_IN,
+#else /* KEY Bug 14150 */
/* Sequence_Array_Dummy */ ERROR_ASSOC,
+#endif /* KEY Bug 14150 */
/* Scalar_Ptr_Dummy */ ERROR_ASSOC,
/* Array_Ptr_Dummy */ ERROR_ASSOC,
/* Assumed_Shape_Dummy */ ERROR_ASSOC,
Modified: trunk/osprey/crayf90/fe90/s_interoperable.c
===================================================================
--- trunk/osprey/crayf90/fe90/s_interoperable.c 2010-11-17 01:07:18 UTC (rev
3402)
+++ trunk/osprey/crayf90/fe90/s_interoperable.c 2010-11-17 22:18:43 UTC (rev
3403)
@@ -63,12 +63,13 @@
* whether attr_idx itself is interoperable.) For example, a variable with
* type integer(c_int) has interoperable type even if the variable itself
* lacks "bind(c)"; a variable of type integer has interoperable type, but
- * if it also has the ALLOCATABLE attribute or is an assumed-shape array, it
- * cannot itself be interoperable (and cannot have the "bind" attribute.)
+ * if it also has the ALLOCATABLE attribute then the variable is not
+ * itself interoperable. This function cares only about the type.
*
* attr_idx AT_Tbl_Idx for a data object (not its type)
* quiet If true, suppress error message
- * ck_arrayness If true, check constraints on array characteristics
+ * ck_arrayness If true, check constraints on array characteristics and
on
+ * character length parameter
* returns TRUE if type of data object is interoperable
*/
boolean
@@ -115,7 +116,7 @@
}
}
else if (linear_type == Character_1) {
- if (!length_type_param_is_one(attr_idx)) {
+ if (ck_arrayness && !length_type_param_is_one(attr_idx)) {
if (!quiet) {
PRINTMSG(AT_DEF_LINE(attr_idx), 1695, Error, AT_DEF_COLUMN(attr_idx),
AT_OBJ_NAME_PTR(attr_idx));
Modified: trunk/osprey/crayf90/fe90/s_intrin.c
===================================================================
--- trunk/osprey/crayf90/fe90/s_intrin.c 2010-11-17 01:07:18 UTC (rev
3402)
+++ trunk/osprey/crayf90/fe90/s_intrin.c 2010-11-17 22:18:43 UTC (rev
3403)
@@ -3,7 +3,7 @@
*/
/*
- * Copyright (C) 2008. PathScale, LLC. All Rights Reserved.
+ * Copyright (C) 2008, 2009. PathScale, LLC. All Rights Reserved.
*/
/*
* Copyright (C) 2006, 2007. QLogic Corporation. All Rights Reserved.
@@ -5751,52 +5751,60 @@
#ifdef KEY /* Bug 14150 */
+/* This area deserves a cleanup some day, to make it mirror in logic and
+ * naming the F2003 standard terminology regarding "interoperable type" vs
+ * "interoperable variable" (the latter encompasses array elements and
+ * substrings) vs interoperable entities. */
+
/*
- * Check argument of ISO_C_BINDING function c_loc or c_funloc
+ * info_idx Index into arg_info_list for an actual arg
+ * returns 0 if the arg has character type and we can statically tell that
+ * its len is not 1
+ */
+static int
+check_interoperable_char(int info_idx) {
+ return arg_info_list[info_idx].ed.type != Character ||
+ OPND_FLD(arg_info_list[info_idx].ed.char_len) != CN_Tbl_Idx ||
+ CN_INT_TO_C(OPND_IDX(arg_info_list[info_idx].ed.char_len)) == 1;
+ }
+
+/*
+ * Check argument of ISO_C_BINDING function c_loc
*
- * which_intrinsic C_Funloc_Intrinsic or C_Loc_Iso_Intrinsic
- * attr_idx AT_Tbl_Idx for argument to c_loc or c_funloc
+ * attr_idx AT_Tbl_Idx for base attribute of this arg of c_loc
* info_idx Index into arg_info_list for this argument
* return error message number, or 0 for no error
*/
static int
-c_loc_iso_arg_check(intrinsic_type which_intrinsic, int attr_idx,
- int info_idx) {
+c_loc_iso_arg_check(int attr_idx, int info_idx) {
int found_error = 0;
- if (which_intrinsic == C_Funloc_Intrinsic &&
- (AT_OBJ_CLASS(attr_idx) != Pgm_Unit ||
- (ATP_PGM_UNIT(attr_idx) != Subroutine &&
- ATP_PGM_UNIT(attr_idx) != Function &&
- ATP_PGM_UNIT(attr_idx) != Pgm_Unknown) ||
- !AT_BIND_ATTR(attr_idx))) {
- found_error = 700;
+ if (AT_OBJ_CLASS(attr_idx) != Data_Obj) {
+ found_error = 700;
}
- else if (which_intrinsic == C_Loc_Iso_Intrinsic) {
- if (AT_OBJ_CLASS(attr_idx) != Data_Obj) {
- found_error = 700;
+ else {
+ int allocatable = arg_info_list[info_idx].ed.allocatable;
+ int pointer = arg_info_list[info_idx].ed.pointer;
+ int target = arg_info_list[info_idx].ed.target;
+ int rank = arg_info_list[info_idx].ed.rank;
+ found_error = (target || pointer) ? 1692 : 418;
+ /* F2003 15.1.2.5 (1) */
+ if ((target && interoperable_variable(attr_idx) &&
+ check_interoperable_char(info_idx)) || /* (1a) */
+ (allocatable && target &&
+ check_interoperable_type(attr_idx, TRUE, FALSE) &&
+ check_interoperable_char(info_idx)) || /* (1b) */
+ (rank == 0 && pointer &&
+ check_interoperable_type(attr_idx, TRUE, FALSE) &&
+ check_interoperable_char(info_idx))) { /* (1c) */
+ found_error = 0;
}
- else {
- int allocatable = arg_info_list[info_idx].ed.allocatable;
- int pointer = arg_info_list[info_idx].ed.pointer;
- int target = arg_info_list[info_idx].ed.target;
- int rank = arg_info_list[info_idx].ed.rank;
- found_error = (target || pointer) ? 1692 : 418;
- /* F2003 15.1.2.5 (1) */
- if ((target && interoperable_variable(attr_idx)) || /* (1a) */
- (allocatable && target &&
- check_interoperable_type(attr_idx, TRUE, FALSE)) || /* (1b) */
- (rank == 0 && pointer &&
- check_interoperable_type(attr_idx, TRUE, FALSE))) { /* (1c) */
+ /* F2003 15.1.2.5 (2) */
+ if (found_error && rank == 0 && no_length_type_param(attr_idx)) {
+ if (((!allocatable) && (!pointer) && target) || /* (a) */
+ (allocatable && target) || /* (b) */
+ pointer) { /* (c) */
found_error = 0;
}
- /* F2003 15.1.2.5 (2) */
- if (found_error && rank == 0 && no_length_type_param(attr_idx)) {
- if (((!allocatable) && (!pointer) && target) || /* (a) */
- (allocatable && target) || /* (b) */
- pointer) { /* (c) */
- found_error = 0;
- }
- }
}
}
return found_error;
@@ -5912,7 +5920,7 @@
if (which_intrinsic == C_Loc_Iso_Intrinsic ||
which_intrinsic == C_Funloc_Intrinsic) {
int found_error = (which_intrinsic == C_Loc_Iso_Intrinsic) ?
- c_loc_iso_arg_check(which_intrinsic, attr_idx, info_idx1) :
+ c_loc_iso_arg_check(attr_idx, info_idx1) :
(AT_BIND_ATTR(attr_idx) ? 0 : 1692);
if (found_error) {
PRINTMSG(arg_info_list[info_idx1].line, found_error, Error,
------------------------------------------------------------------------------
Beautiful is writing same markup. Internet Explorer 9 supports
standards for HTML5, CSS3, SVG 1.1, ECMAScript5, and DOM L2 & L3.
Spend less time writing and rewriting code and more time creating great
experiences on the web. Be a part of the beta today
http://p.sf.net/sfu/msIE9-sfdev2dev
_______________________________________________
Open64-devel mailing list
[email protected]
https://lists.sourceforge.net/lists/listinfo/open64-devel
