re PR fortran/28174 (Corruption of multiple character arrays when passing array sections)

2006-07-13  Paul Thomas  <pault@gcc.gnu.org>

	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  <pault@gcc.gnu.org>

	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

diff --git a/gcc/fortran/ChangeLog b/gcc/fortran/ChangeLog
index 89497e4c00abeeb056f1c35c846c90b3718ca561..c9a95ce7a978dad5bbac1571f01c9cce0e962218 100644 (file)
--- a/gcc/fortran/ChangeLog
+++ b/gcc/fortran/ChangeLog
@@ -1,3 +1,18 @@
+006-07-13  Paul Thomas  <pault@gcc.gnu.org>
+
+       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  <coudert@clipper.ens.fr>
 
        PR fortran/28163

diff --git a/gcc/fortran/check.c b/gcc/fortran/check.c
index 5f536f5920869bd722c2dea790dca130fee7834a..1332c2bd6aa8a2c2e0395ca4e961d7a8e72a4d27 100644 (file)
--- 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 5eca35d6c6a3d7c5ac4daf10407762c6eee5db73..fb980d63451b6e9cf1181e85a0396ff2c03027dc 100644 (file)
--- 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 5c396ef7d64889936a053f01a7a29e07684a0fd3..de003ec52234a66d13261fb6b1572004ea1cf8d0 100644 (file)
--- 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 54af3356681530f42baa5d6daa498b3c3c2c264e..e196166193503cf99588edf77ffb966f62e2b9bf 100644 (file)
--- a/gcc/testsuite/ChangeLog
+++ b/gcc/testsuite/ChangeLog
@@ -1,3 +1,11 @@
+2006-07-13  Paul Thomas  <pault@gcc.gnu.org>
+
+       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  <fengwang@nudt.edu.cn>
 
        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 (file)
index 0000000..7c165b3
--- /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 <jv244@cam.ac.uk>
+! 
+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 (file)
index 0000000..b7b9836
--- /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 <jv244@cam.ac.uk>
+!
+ 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
+