From 0e3e65bc57c4601556cc684f95bef7a6603f8400 Mon Sep 17 00:00:00 2001 From: Paul Thomas Date: Fri, 21 Apr 2006 05:10:22 +0000 Subject: [PATCH] re PR fortran/27122 (binary operator functions should require intent(in)) 2006-04-21 Paul Thomas 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-21 Paul Thomas 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. From-SVN: r113133 --- gcc/fortran/ChangeLog | 14 +++ gcc/fortran/resolve.c | 93 +++++++++++++++---- gcc/fortran/trans-array.c | 5 +- gcc/testsuite/ChangeLog | 10 ++ .../assumed_charlen_function_1.f90 | 8 +- .../character_array_constructor_1.f90 | 47 ++++++++++ .../gfortran.dg/defined_operators_1.f90 | 56 +++++++++++ 7 files changed, 203 insertions(+), 30 deletions(-) create mode 100644 gcc/testsuite/gfortran.dg/character_array_constructor_1.f90 create mode 100644 gcc/testsuite/gfortran.dg/defined_operators_1.f90 diff --git a/gcc/fortran/ChangeLog b/gcc/fortran/ChangeLog index c9547172fb63..003f9312b7f8 100644 --- a/gcc/fortran/ChangeLog +++ b/gcc/fortran/ChangeLog @@ -1,3 +1,17 @@ +2006-04-21 Paul Thomas + + 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 * parse.c (next_free): Use consistent error string between diff --git a/gcc/fortran/resolve.c b/gcc/fortran/resolve.c index f7acb7312694..fce232213672 100644 --- a/gcc/fortran/resolve.c +++ b/gcc/fortran/resolve.c @@ -1237,28 +1237,16 @@ resolve_function (gfc_expr * expr) 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. */ @@ -6105,6 +6093,68 @@ resolve_fntype (gfc_namespace * ns) } } +/* 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 @@ -6164,6 +6214,9 @@ resolve_types (gfc_namespace * ns) /* Warn about unused labels. */ if (gfc_option.warn_unused_labels) warn_unused_label (ns->st_labels); + + gfc_resolve_uops (ns->uop_root); + } diff --git a/gcc/fortran/trans-array.c b/gcc/fortran/trans-array.c index 0157e62cb879..fcd2223d96b0 100644 --- a/gcc/fortran/trans-array.c +++ b/gcc/fortran/trans-array.c @@ -1035,9 +1035,6 @@ gfc_trans_array_constructor_subarray (stmtblock_t * pblock, 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); @@ -1311,7 +1308,7 @@ get_array_ctor_var_strlen (gfc_expr * expr, tree * len) /* 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; diff --git a/gcc/testsuite/ChangeLog b/gcc/testsuite/ChangeLog index bbc744fd6fea..bc315da37698 100644 --- a/gcc/testsuite/ChangeLog +++ b/gcc/testsuite/ChangeLog @@ -1,3 +1,13 @@ +2006-04-21 Paul Thomas + + 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 * gcc.dg/20060419-1.c: New test. diff --git a/gcc/testsuite/gfortran.dg/assumed_charlen_function_1.f90 b/gcc/testsuite/gfortran.dg/assumed_charlen_function_1.f90 index e10fd70b5841..a28934e2597e 100644 --- a/gcc/testsuite/gfortran.dg/assumed_charlen_function_1.f90 +++ b/gcc/testsuite/gfortran.dg/assumed_charlen_function_1.f90 @@ -17,7 +17,7 @@ END MODULE M1 MODULE INTEGER_SETS INTERFACE OPERATOR (.IN.) - FUNCTION ELEMENT(X,A) + FUNCTION ELEMENT(X,A) ! { dg-error "cannot be assumed character length" } USE M1 CHARACTER(LEN=*) :: ELEMENT INTEGER, INTENT(IN) :: X @@ -59,7 +59,6 @@ function not_OK (ch) not_OK = ch end function not_OK - use INTEGER_SETS use m1 character(4) :: answer @@ -74,11 +73,8 @@ end function not_OK end function ext end interface - answer = i.IN.z ! { dg-error "cannot be used|Operands of user operator" } - answer = ext (2) ! { dg-error "but cannot be used" } - answer = not_OK ("unOK") ! { dg-error "since it is not a dummy" } END -! { dg-final { cleanup-modules "M1 INTEGER_SETS" } } +! { dg-final { cleanup-modules "M1" } } diff --git a/gcc/testsuite/gfortran.dg/character_array_constructor_1.f90 b/gcc/testsuite/gfortran.dg/character_array_constructor_1.f90 new file mode 100644 index 000000000000..ac0f7e315df7 --- /dev/null +++ b/gcc/testsuite/gfortran.dg/character_array_constructor_1.f90 @@ -0,0 +1,47 @@ +! { 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 +! + 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 diff --git a/gcc/testsuite/gfortran.dg/defined_operators_1.f90 b/gcc/testsuite/gfortran.dg/defined_operators_1.f90 new file mode 100644 index 000000000000..f7688b87a55b --- /dev/null +++ b/gcc/testsuite/gfortran.dg/defined_operators_1.f90 @@ -0,0 +1,56 @@ +! { 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 +! +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