+2006-04-21 Paul Thomas <pault@gcc.gnu.org>
+
+ PR fortran/27122
+ * resolve.c (resolve_function): Remove general restriction on auto
+ character length function interfaces.
+ (gfc_resolve_uops): Check restrictions on defined operator
+ procedures.
+ (resolve_types): Call the check for defined operators.
+
+ PR fortran/27113
+ * trans-array.c (gfc_trans_array_constructor_subarray): Remove
+ redundant gfc_todo_error.
+ (get_array_ctor_var_strlen): Remove typo in enum.
+
2006-04-18 Bernhard Fischer <aldot@gcc.gnu.org>
* parse.c (next_free): Use consistent error string between
need_full_assumed_size--;
if (sym && sym->ts.type == BT_CHARACTER
- && sym->ts.cl && sym->ts.cl->length == NULL)
+ && sym->ts.cl
+ && sym->ts.cl->length == NULL
+ && !sym->attr.dummy
+ && !sym->attr.contained)
{
- if (sym->attr.if_source == IFSRC_IFBODY)
- {
- /* This follows from a slightly odd requirement at 5.1.1.5 in the
- standard that allows assumed character length functions to be
- declared in interfaces but not used. Picking up the symbol here,
- rather than resolve_symbol, accomplishes that. */
- gfc_error ("Function '%s' can be declared in an interface to "
- "return CHARACTER(*) but cannot be used at %L",
- sym->name, &expr->where);
- return FAILURE;
- }
-
/* Internal procedures are taken care of in resolve_contained_fntype. */
- if (!sym->attr.dummy && !sym->attr.contained)
- {
- gfc_error ("Function '%s' is declared CHARACTER(*) and cannot "
- "be used at %L since it is not a dummy argument",
- sym->name, &expr->where);
- return FAILURE;
- }
+ gfc_error ("Function '%s' is declared CHARACTER(*) and cannot "
+ "be used at %L since it is not a dummy argument",
+ sym->name, &expr->where);
+ return FAILURE;
}
/* See if function is already resolved. */
}
}
+/* 12.3.2.1.1 Defined operators. */
+
+static void
+gfc_resolve_uops(gfc_symtree *symtree)
+{
+ gfc_interface *itr;
+ gfc_symbol *sym;
+ gfc_formal_arglist *formal;
+
+ if (symtree == NULL)
+ return;
+
+ gfc_resolve_uops (symtree->left);
+ gfc_resolve_uops (symtree->right);
+
+ for (itr = symtree->n.uop->operator; itr; itr = itr->next)
+ {
+ sym = itr->sym;
+ if (!sym->attr.function)
+ gfc_error("User operator procedure '%s' at %L must be a FUNCTION",
+ sym->name, &sym->declared_at);
+
+ if (sym->ts.type == BT_CHARACTER
+ && !(sym->ts.cl && sym->ts.cl->length)
+ && !(sym->result && sym->result->ts.cl && sym->result->ts.cl->length))
+ gfc_error("User operator procedure '%s' at %L cannot be assumed character "
+ "length", sym->name, &sym->declared_at);
+
+ formal = sym->formal;
+ if (!formal || !formal->sym)
+ {
+ gfc_error("User operator procedure '%s' at %L must have at least "
+ "one argument", sym->name, &sym->declared_at);
+ continue;
+ }
+
+ if (formal->sym->attr.intent != INTENT_IN)
+ gfc_error ("First argument of operator interface at %L must be "
+ "INTENT(IN)", &sym->declared_at);
+
+ if (formal->sym->attr.optional)
+ gfc_error ("First argument of operator interface at %L cannot be "
+ "optional", &sym->declared_at);
+
+ formal = formal->next;
+ if (!formal || !formal->sym)
+ continue;
+
+ if (formal->sym->attr.intent != INTENT_IN)
+ gfc_error ("Second argument of operator interface at %L must be "
+ "INTENT(IN)", &sym->declared_at);
+
+ if (formal->sym->attr.optional)
+ gfc_error ("Second argument of operator interface at %L cannot be "
+ "optional", &sym->declared_at);
+
+ if (formal->next)
+ gfc_error ("Operator interface at %L must have, at most, two "
+ "arguments", &sym->declared_at);
+ }
+}
+
/* Examine all of the expressions associated with a program unit,
assign types to all intermediate expressions, make sure that all
/* Warn about unused labels. */
if (gfc_option.warn_unused_labels)
warn_unused_label (ns->st_labels);
+
+ gfc_resolve_uops (ns->uop_root);
+
}
gfc_copy_loopinfo_to_se (&se, &loop);
se.ss = ss;
- if (expr->ts.type == BT_CHARACTER)
- gfc_todo_error ("character arrays in constructors");
-
gfc_trans_array_ctor_element (&body, desc, *poffset, &se, expr);
gcc_assert (se.ss == gfc_ss_terminator);
/* Array references don't change the string length. */
break;
- case COMPONENT_REF:
+ case REF_COMPONENT:
/* Use the length of the component. */
ts = &ref->u.c.component->ts;
break;
+2006-04-21 Paul Thomas <pault@gcc.gnu.org>
+
+ PR fortran/27122
+ * gfortran.dg/defined_operators_1.f90: New test.
+ * gfortran.dg/assumed_charlen_function_1.f90: Add new error and
+ remove old ones associated, incorrectly, with Note 5.46.
+
+ PR fortran/27113
+ * gfortran.dg/character_array_constructor_1.f90: New test.
+
2006-04-20 Jakub Jelinek <jakub@redhat.com>
* gcc.dg/20060419-1.c: New test.
\r
MODULE INTEGER_SETS\r
INTERFACE OPERATOR (.IN.)\r
- FUNCTION ELEMENT(X,A)\r
+ FUNCTION ELEMENT(X,A) ! { dg-error "cannot be assumed character length" }\r
USE M1\r
CHARACTER(LEN=*) :: ELEMENT\r
INTEGER, INTENT(IN) :: X\r
not_OK = ch\r
end function not_OK\r
\r
- use INTEGER_SETS\r
use m1\r
\r
character(4) :: answer\r
end function ext\r
end interface\r
\r
- answer = i.IN.z ! { dg-error "cannot be used|Operands of user operator" }\r
- answer = ext (2) ! { dg-error "but cannot be used" }\r
-\r
answer = not_OK ("unOK") ! { dg-error "since it is not a dummy" }\r
\r
END\r
\r
-! { dg-final { cleanup-modules "M1 INTEGER_SETS" } }\r
+! { dg-final { cleanup-modules "M1" } }\r
--- /dev/null
+! { dg-do run }
+! Tests the fix for PR27113, in which character structure
+! components would produce the TODO compilation error "complex
+! character array constructors".
+!
+! Test based on part of tonto-2.2;
+! Contributed by Paul Thomas <pault@gcc.gnu.org>
+!
+ type BASIS_TYPE
+ character(len=8) :: label
+ end type
+
+ type(BASIS_TYPE), dimension(:), pointer :: ptr
+ character(8), dimension(2) :: carray
+
+ allocate (ptr(2))
+ ptr(1)%label = "Label 1"
+ ptr(2)%label = "Label 2"
+
+! This is the original bug
+ call read_library_data_((/ptr%label/))
+
+ carray(1) = "Label 3"
+ carray(2) = "Label 4"
+
+! Mix a character array with the character component of a derived type pointer array.
+ call read_library_data_((/carray, ptr%label/))
+
+! Finally, add a constant (character(8)).
+ call read_library_data_((/carray, ptr%label, "Label 5 "/))
+
+contains
+
+ subroutine read_library_data_ (chr)
+ character(*), dimension(:) :: chr
+ character(len = len(chr)) :: tmp
+ if (size(chr,1) == 2) then
+ if (any (chr .ne. (/"Label 1", "Label 2"/))) call abort ()
+ elseif (size(chr,1) == 4) then
+ if (any (chr .ne. (/"Label 3", "Label 4","Label 1", "Label 2"/))) call abort ()
+ elseif (size(chr,1) == 5) then
+ if (any (chr .ne. (/"Label 3", "Label 4","Label 1", "Label 2", "Label 5"/))) &
+ call abort ()
+ end if
+ end subroutine read_library_data_
+
+end
--- /dev/null
+! { dg-do compile }
+! { dg-options "-std=legacy" }
+! Tests the fix for PR27122, in which the requirements of 12.3.2.1.1
+! for defined operators were not enforced.
+!
+! Based on PR test by Thomas Koenig <tkoenig@gcc.gnu.org>
+!
+module mymod
+ interface operator (.foo.)
+ module procedure foo_0 ! { dg-error "must have at least one argument" }
+ module procedure foo_1 ! { dg-error "must be INTENT" }
+ module procedure foo_2 ! { dg-error "cannot be optional" }
+ module procedure foo_3 ! { dg-error "must have, at most, two arguments" }
+ module procedure foo_1_OK
+ module procedure foo_2_OK
+ function foo_chr (chr) ! { dg-error "cannot be assumed character length" }
+ character(*) :: foo_chr
+ character(*), intent(in) :: chr
+ end function foo_chr
+ subroutine bad_foo (chr) ! { dg-error "must be a FUNCTION" }
+ character(*), intent(in) :: chr
+ end subroutine bad_foo
+ end interface
+contains
+ function foo_0 ()
+ integer :: foo_1
+ foo_0 = 1
+ end function foo_0
+ function foo_1 (a)
+ integer :: foo_1
+ integer :: a
+ foo_1 = 1
+ end function foo_1
+ function foo_1_OK (a)
+ integer :: foo_1_OK
+ integer, intent (in) :: a
+ foo_1_OK = 1
+ end function foo_1_OK
+ function foo_2 (a, b)
+ integer :: foo_2
+ integer, intent(in) :: a
+ integer, intent(in), optional :: b
+ foo_2 = 2 * a + b
+ end function foo_2
+ function foo_2_OK (a, b)
+ real :: foo_2_OK
+ real, intent(in) :: a
+ real, intent(in) :: b
+ foo_2_OK = 2.0 * a + b
+ end function foo_2_OK
+ function foo_3 (a, b, c)
+ integer :: foo_3
+ integer, intent(in) :: a, b, c
+ foo_3 = a + 3 * b - c
+ end function foo_3
+end module mymod
projects / platform / upstream / linaro-gcc.git / commitdiff