diff --git a/gcc/fortran/ChangeLog b/gcc/fortran/ChangeLog index e1a4942d7da..d7c4e706958 100644 --- a/gcc/fortran/ChangeLog +++ b/gcc/fortran/ChangeLog @@ -1,3 +1,19 @@ +2007-07-10 Paul Thomas + + PR fortran/32157 + * resolve.c (is_external_proc): New function. Adds test that + the symbol is not an intrinsic procedure. + * (resolve_function, resolve_call): Replace logical statements + with call to is_external_proc. + + PR fortran/32689 + * simplify.c (gfc_simplify_transfer): If mold has rank, the + result is an array. + + PR fortran/32634 + * module.c (write_generic): Write the local name of the + interface. + 2007-07-09 Francois-Xavier Coudert PR fortran/29459 diff --git a/gcc/fortran/module.c b/gcc/fortran/module.c index 288f1f92a35..1471b8bf580 100644 --- a/gcc/fortran/module.c +++ b/gcc/fortran/module.c @@ -3947,6 +3947,9 @@ write_operator (gfc_user_op *uop) static void write_generic (gfc_symbol *sym) { + const char *p; + int nuse, j; + if (sym->generic == NULL || !gfc_check_access (sym->attr.access, sym->ns->default_access)) return; @@ -3954,7 +3957,20 @@ write_generic (gfc_symbol *sym) if (sym->module == NULL) sym->module = gfc_get_string (module_name); - mio_symbol_interface (&sym->name, &sym->module, &sym->generic); + /* See how many use names there are. If none, go through the loop + at least once. */ + nuse = number_use_names (sym->name); + if (nuse == 0) + nuse = 1; + + for (j = 1; j <= nuse; j++) + { + /* Get the jth local name for this symbol. */ + p = find_use_name_n (sym->name, &j); + + /* Make an interface with that name. */ + mio_symbol_interface (&p, &sym->module, &sym->generic); + } } diff --git a/gcc/fortran/resolve.c b/gcc/fortran/resolve.c index 97bcc853c72..911d5ecd3ae 100644 --- a/gcc/fortran/resolve.c +++ b/gcc/fortran/resolve.c @@ -1552,6 +1552,22 @@ set_type: } +/* Return true, if the symbol is an external procedure. */ +static bool +is_external_proc (gfc_symbol *sym) +{ + if (!sym->attr.dummy && !sym->attr.contained + && !(sym->attr.intrinsic + || gfc_intrinsic_name (sym->name, sym->attr.subroutine)) + && sym->attr.proc != PROC_ST_FUNCTION + && !sym->attr.use_assoc + && sym->name) + return true; + else + return false; +} + + /* Figure out if a function reference is pure or not. Also set the name of the function for a potential error message. Return nonzero if the function is PURE, zero if not. */ @@ -1893,12 +1909,8 @@ resolve_function (gfc_expr *expr) return FAILURE; } - /* If the procedure is not internal, a statement function or a module - procedure,it must be external and should be checked for usage. */ - if (sym && !sym->attr.dummy && !sym->attr.contained - && sym->attr.proc != PROC_ST_FUNCTION - && !sym->attr.use_assoc - && sym->name ) + /* If the procedure is external, check for usage. */ + if (sym && is_external_proc (sym)) resolve_global_procedure (sym, &expr->where, 0); /* Switch off assumed size checking and do this again for certain kinds @@ -2490,12 +2502,8 @@ resolve_call (gfc_code *c) return FAILURE; } - /* If the procedure is not internal or module, it must be external and - should be checked for usage. */ - if (c->symtree && c->symtree->n.sym - && !c->symtree->n.sym->attr.dummy - && !c->symtree->n.sym->attr.contained - && !c->symtree->n.sym->attr.use_assoc) + /* If external, check for usage. */ + if (c->symtree && is_external_proc (c->symtree->n.sym)) resolve_global_procedure (c->symtree->n.sym, &c->loc, 1); /* Subroutines without the RECURSIVE attribution are not allowed to diff --git a/gcc/fortran/simplify.c b/gcc/fortran/simplify.c index 9dd308425c2..6b8eb43c6b0 100644 --- a/gcc/fortran/simplify.c +++ b/gcc/fortran/simplify.c @@ -3924,7 +3924,7 @@ gfc_simplify_transfer (gfc_expr *source, gfc_expr *mold, gfc_expr *size) /* Set the number of elements in the result, and determine its size. */ result_elt_size = gfc_target_expr_size (mold_element); - if (mold->expr_type == EXPR_ARRAY || size) + if (mold->expr_type == EXPR_ARRAY || mold->rank || size) { int result_length; diff --git a/gcc/testsuite/ChangeLog b/gcc/testsuite/ChangeLog index edbe7edd628..20ec01f753f 100644 --- a/gcc/testsuite/ChangeLog +++ b/gcc/testsuite/ChangeLog @@ -1,3 +1,14 @@ +2007-07-10 Paul Thomas + + PR fortran/32157 + * gfortran.dg/overload_2.f90: New test. + + PR fortran/32689 + * gfortran.dg/transfer_simplify_5.f90 + + PR fortran/32634 + * gfortran.dg/interface_15.f90: New test. + 2007-07-09 Thomas Koenig PR libfortran/32336 diff --git a/gcc/testsuite/gfortran.dg/interface_16.f90 b/gcc/testsuite/gfortran.dg/interface_16.f90 new file mode 100644 index 00000000000..8be9d684a66 --- /dev/null +++ b/gcc/testsuite/gfortran.dg/interface_16.f90 @@ -0,0 +1,101 @@ +! { dg-do compile } +! This tests the fix for PR32634, in which the generic interface +! in foo_pr_mod was given the original rather than the local name. +! This meant that the original name had to be used in the calll +! in foo_sub. +! +! Contributed by Salvatore Filippone + +module foo_base_mod + type foo_dmt + real(kind(1.d0)), allocatable :: rv(:) + integer, allocatable :: iv1(:), iv2(:) + end type foo_dmt + type foo_zmt + complex(kind(1.d0)), allocatable :: rv(:) + integer, allocatable :: iv1(:), iv2(:) + end type foo_zmt + type foo_cdt + integer, allocatable :: md(:) + integer, allocatable :: hi(:), ei(:) + end type foo_cdt +end module foo_base_mod + +module bar_prt + use foo_base_mod, only : foo_dmt, foo_zmt, foo_cdt + type bar_dbprt + type(foo_dmt), allocatable :: av(:) + real(kind(1.d0)), allocatable :: d(:) + type(foo_cdt) :: cd + end type bar_dbprt + type bar_dprt + type(bar_dbprt), allocatable :: bpv(:) + end type bar_dprt + type bar_zbprt + type(foo_zmt), allocatable :: av(:) + complex(kind(1.d0)), allocatable :: d(:) + type(foo_cdt) :: cd + end type bar_zbprt + type bar_zprt + type(bar_zbprt), allocatable :: bpv(:) + end type bar_zprt +end module bar_prt + +module bar_pr_mod + use bar_prt + interface bar_pwrk + subroutine bar_dppwrk(pr,x,y,cd,info,trans,work) + use foo_base_mod + use bar_prt + type(foo_cdt),intent(in) :: cd + type(bar_dprt), intent(in) :: pr + real(kind(0.d0)),intent(inout) :: x(:), y(:) + integer, intent(out) :: info + character(len=1), optional :: trans + real(kind(0.d0)),intent(inout), optional, target :: work(:) + end subroutine bar_dppwrk + subroutine bar_zppwrk(pr,x,y,cd,info,trans,work) + use foo_base_mod + use bar_prt + type(foo_cdt),intent(in) :: cd + type(bar_zprt), intent(in) :: pr + complex(kind(0.d0)),intent(inout) :: x(:), y(:) + integer, intent(out) :: info + character(len=1), optional :: trans + complex(kind(0.d0)),intent(inout), optional, target :: work(:) + end subroutine bar_zppwrk + end interface +end module bar_pr_mod + +module foo_pr_mod + use bar_prt, & + & foo_dbprt => bar_dbprt,& + & foo_zbprt => bar_zbprt,& + & foo_dprt => bar_dprt,& + & foo_zprt => bar_zprt + use bar_pr_mod, & + & foo_pwrk => bar_pwrk +end module foo_pr_mod + +Subroutine foo_sub(a,pr,b,x,eps,cd,info) + use foo_base_mod + use foo_pr_mod + Implicit None +!!$ parameters + Type(foo_dmt), Intent(in) :: a + Type(foo_dprt), Intent(in) :: pr + Type(foo_cdt), Intent(in) :: cd + Real(Kind(1.d0)), Intent(in) :: b(:) + Real(Kind(1.d0)), Intent(inout) :: x(:) + Real(Kind(1.d0)), Intent(in) :: eps + integer, intent(out) :: info +!!$ Local data + Real(Kind(1.d0)), allocatable, target :: aux(:),wwrk(:,:) + Real(Kind(1.d0)), allocatable :: p(:), f(:) + info = 0 + Call foo_pwrk(pr,p,f,cd,info,work=aux) ! This worked if bar_pwrk was called! + return +End Subroutine foo_sub + +! { dg-final { cleanup-modules "foo_base_mod foo_pr_mod bar_pr_mod bar_prt" } } + diff --git a/gcc/testsuite/gfortran.dg/overload_2.f90 b/gcc/testsuite/gfortran.dg/overload_2.f90 new file mode 100644 index 00000000000..feefb460722 --- /dev/null +++ b/gcc/testsuite/gfortran.dg/overload_2.f90 @@ -0,0 +1,27 @@ +! { dg-do compile } +! Test the fix for PR32157, in which overloading 'LEN', as +! in 'test' below would cause a compile error. +! +! Contributed by Michael Richmond +! +subroutine len(c) + implicit none + character :: c + c = "X" +end subroutine len + +subroutine test() + implicit none + character :: str + external len + call len(str) + if(str /= "X") call abort() +end subroutine test + +PROGRAM VAL + implicit none + external test + intrinsic len + call test() + if(len(" ") /= 1) call abort() +END diff --git a/gcc/testsuite/gfortran.dg/transfer_simplify_5.f90 b/gcc/testsuite/gfortran.dg/transfer_simplify_5.f90 new file mode 100644 index 00000000000..65905b87a56 --- /dev/null +++ b/gcc/testsuite/gfortran.dg/transfer_simplify_5.f90 @@ -0,0 +1,16 @@ +! { dg-do compile } +! Tests the fix for PR32689, in which the TRANSFER with MOLD +! an array variable, as below, did not simplify. +! +! Contributed by Harald Anlauf +! +program gfcbug67 + implicit none + + type mytype + integer, pointer :: i(:) => NULL () + end type mytype + type(mytype) :: t + + print *, size (transfer (1, t% i)) +end program gfcbug67