From 72af9f0b517b8dec055f72bf2ba7bfcb2e8da99b Mon Sep 17 00:00:00 2001 From: Paul Thomas Date: Thu, 13 Jul 2006 05:07:35 +0000 Subject: [PATCH] re PR fortran/28174 (Corruption of multiple character arrays when passing array sections) 2006-07-13 Paul Thomas PR fortran/28174 * trans-expr.c (gfc_conv_aliased_arg): Missing formal arg means that intent is INOUT (fixes regression). PR fortran/25097 * check.c (check_present): The only permitted reference is a full array reference. PR fortran/20903 * decl.c (variable_decl): Add error if a derived type is not from the current namespace if the namespace is an interface body. 2006-07-13 Paul Thomas PR fortran/25097 * gfortran.dg/present_1.f90: New test. PR fortran/20903 * gfortran.dg/interface_derived_type_1.f90: New test. From-SVN: r115410 --- gcc/fortran/ChangeLog | 15 ++++++ gcc/fortran/check.c | 16 ++++++ gcc/fortran/decl.c | 14 +++++ gcc/fortran/trans-expr.c | 3 +- gcc/testsuite/ChangeLog | 8 +++ .../gfortran.dg/interface_derived_type_1.f90 | 54 +++++++++++++++++++ gcc/testsuite/gfortran.dg/present_1.f90 | 20 +++++++ 7 files changed, 129 insertions(+), 1 deletion(-) create mode 100644 gcc/testsuite/gfortran.dg/interface_derived_type_1.f90 create mode 100644 gcc/testsuite/gfortran.dg/present_1.f90 diff --git a/gcc/fortran/ChangeLog b/gcc/fortran/ChangeLog index 89497e4c00a..c9a95ce7a97 100644 --- a/gcc/fortran/ChangeLog +++ b/gcc/fortran/ChangeLog @@ -1,3 +1,18 @@ +006-07-13 Paul Thomas + + PR fortran/28174 + * trans-expr.c (gfc_conv_aliased_arg): Missing formal arg means + that intent is INOUT (fixes regression). + + PR fortran/25097 + * check.c (check_present): The only permitted reference is a + full array reference. + + PR fortran/20903 + * decl.c (variable_decl): Add error if a derived type is not + from the current namespace if the namespace is an interface + body. + 2006-07-12 Francois-Xavier Coudert PR fortran/28163 diff --git a/gcc/fortran/check.c b/gcc/fortran/check.c index 5f536f59208..1332c2bd6aa 100644 --- a/gcc/fortran/check.c +++ b/gcc/fortran/check.c @@ -1867,6 +1867,22 @@ gfc_check_present (gfc_expr * a) return FAILURE; } +/* 13.14.82 PRESENT(A) +...... + Argument. A shall be the name of an optional dummy argument that is accessible + in the subprogram in which the PRESENT function reference appears... */ + + if (a->ref != NULL + && !(a->ref->next == NULL + && a->ref->type == REF_ARRAY + && a->ref->u.ar.type == AR_FULL)) + { + gfc_error ("'%s' argument of '%s' intrinsic at %L must not be a sub-" + "object of '%s'", gfc_current_intrinsic_arg[0], + gfc_current_intrinsic, &a->where, sym->name); + return FAILURE; + } + return SUCCESS; } diff --git a/gcc/fortran/decl.c b/gcc/fortran/decl.c index 5eca35d6c6a..fb980d63451 100644 --- a/gcc/fortran/decl.c +++ b/gcc/fortran/decl.c @@ -1176,6 +1176,20 @@ variable_decl (int elem) goto cleanup; } + /* An interface body specifies all of the procedure's characteristics and these + shall be consistent with those specified in the procedure definition, except + that the interface may specify a procedure that is not pure if the procedure + is defined to be pure(12.3.2). */ + if (current_ts.type == BT_DERIVED + && gfc_current_ns->proc_name->attr.if_source == IFSRC_IFBODY + && current_ts.derived->ns != gfc_current_ns) + { + gfc_error ("the type of '%s' at %C has not been declared within the " + "interface", name); + m = MATCH_ERROR; + goto cleanup; + } + /* In functions that have a RESULT variable defined, the function name always refers to function calls. Therefore, the name is not allowed to appear in specification statements. */ diff --git a/gcc/fortran/trans-expr.c b/gcc/fortran/trans-expr.c index 5c396ef7d64..de003ec5223 100644 --- a/gcc/fortran/trans-expr.c +++ b/gcc/fortran/trans-expr.c @@ -1981,7 +1981,8 @@ gfc_conv_function_call (gfc_se * se, gfc_symbol * sym, array of derived types. In this case, the argument is converted to a temporary, which is passed and then written back after the procedure call. */ - gfc_conv_aliased_arg (&parmse, e, f, fsym->attr.intent); + gfc_conv_aliased_arg (&parmse, e, f, + fsym ? fsym->attr.intent : INTENT_INOUT); else gfc_conv_array_parameter (&parmse, e, argss, f); diff --git a/gcc/testsuite/ChangeLog b/gcc/testsuite/ChangeLog index 54af3356681..e1961661935 100644 --- a/gcc/testsuite/ChangeLog +++ b/gcc/testsuite/ChangeLog @@ -1,3 +1,11 @@ +2006-07-13 Paul Thomas + + PR fortran/25097 + * gfortran.dg/present_1.f90: New test. + + PR fortran/20903 + * gfortran.dg/interface_derived_type_1.f90: New test. + 2006-07-11 Feng Wang PR fortran/28213 diff --git a/gcc/testsuite/gfortran.dg/interface_derived_type_1.f90 b/gcc/testsuite/gfortran.dg/interface_derived_type_1.f90 new file mode 100644 index 00000000000..7c165b336e9 --- /dev/null +++ b/gcc/testsuite/gfortran.dg/interface_derived_type_1.f90 @@ -0,0 +1,54 @@ +! { dg-do compile } +! Test the fix for PR20903, in which derived types could be host associated within +! interface bodies. +! +! Contributed by Joost VandeVondele +! +module test + implicit none + type fcnparms + integer :: i + end type fcnparms +contains + subroutine sim_1(func1,params) + interface + function func1(fparams) + type(fcnparms) :: fparams ! { dg-error "not been declared within the interface" } + real :: func1 + end function func1 + end interface + type(fcnparms) :: params + end subroutine sim_1 + + subroutine sim_2(func2,params) + interface + function func2(fparams) ! This is OK because of the derived type decl. + type fcnparms + integer :: i + end type fcnparms + type(fcnparms) :: fparams + real :: func2 + end function func2 + end interface + type(fcnparms) :: params ! This is OK, of course + end subroutine sim_2 +end module test + +module type_decl + implicit none + type fcnparms + integer :: i + end type fcnparms +end module type_decl + +subroutine sim_3(func3,params) + use type_decl + interface + function func3(fparams) + use type_decl + type(fcnparms) :: fparams ! This is OK - use associated + real :: func3 + end function func3 + end interface + type(fcnparms) :: params ! -ditto- +end subroutine sim_3 diff --git a/gcc/testsuite/gfortran.dg/present_1.f90 b/gcc/testsuite/gfortran.dg/present_1.f90 new file mode 100644 index 00000000000..b7b983610c4 --- /dev/null +++ b/gcc/testsuite/gfortran.dg/present_1.f90 @@ -0,0 +1,20 @@ +! { dg-do compile } +! Test the fix for PR25097, in which subobjects of the optional dummy argument +! could appear as argument A of the PRESENT intrinsic. +! +! Contributed by Joost VandeVondele +! + MODULE M1 + TYPE T1 + INTEGER :: I + END TYPE T1 + CONTAINS + SUBROUTINE S1(D1) + TYPE(T1), OPTIONAL :: D1(4) + write(6,*) PRESENT(D1%I) ! { dg-error "must not be a sub-object" } + write(6,*) PRESENT(D1(1)) ! { dg-error "must not be a sub-object" } + write(6,*) PRESENT(D1) + END SUBROUTINE S1 + END MODULE + END +