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

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

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;
 }
 

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.  */

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);
 

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

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

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
+