This is the mail archive of the gcc-patches@gcc.gnu.org mailing list for the GCC project.


Index Nav: [Date Index] [Subject Index] [Author Index] [Thread Index]
Message Nav: [Date Prev] [Date Next] [Thread Prev] [Thread Next]
Other format: [Raw text]

[Patch, Fortran] PR25071 - give an error if character len of actual argument too short


:ADDPATCH fortran:

This fixes part* of PR25071. An error is printed if it is known at
compile time that the character length of the actual argument is shorter
than the one of the formal argument.

Additionally, if the formal/dummy argument is a pointer or allocatable
then the length ("type parameter") needs to match exactly.

We give in both cases an error as NAG f95 does. g95 gives a warning for
the first and an error for the second. ifort and sunf95 gives an error
for the first and accepts the second without any notice.


>From the Fortran standard:

"12.4.1.2 Actual arguments associated with dummy data objects"

"The type parameter values of the actual argument shall  agree with the
corresponding ones of the dummy argument that are not assumed or
deferred, except for the case of the character length parameter of an
actual argument of type default character associated with a dummy
argument that is not assumed shape."

"If a scalar dummy argument is of type default character, the length len
of the dummy argument shall be less than or equal to the length of the
actual argument. The dummy argument becomes associated with the leftmost
len characters of the actual argument. If an array dummy argument is of
type default character and is not assumed shape, it becomes associated
with the leftmost characters of the actual argument element sequence
(12.4.1.5) and it shall not extend beyond the end of that sequence."

"If the dummy argument is a pointer, the actual argument shall be a
pointer and the nondeferred type parameters and ranks shall agree. If a
dummy argument is allocatable, the actual argument shall be allocatable
and the nondeferred type parameters and ranks shall agree."

Build and regression tested with no failures but 
gfortran.fortran-torture/execute/st_function.f90 (PR31095).

Ok for the trunk?

Tobias

* The unfixed part is to do the same check for arrays; here one has to
check the storage extent.
2007-05-03  Tobias Burnus  <burnus@net-b.de>

	PR fortran/25071
	* interface.c (compare_actual_formal): Check character length.

2007-05-03  Tobias Burnus  <burnus@net-b.de>

	PR fortran/25071
	* gfortran.dg/char_length_3.f90: New test.
	* gfortran.dg/char_result_2.f90: Fix test.

Index: gcc/fortran/interface.c
===================================================================
--- gcc/fortran/interface.c	(revision 124381)
+++ gcc/fortran/interface.c	(working copy)
@@ -1369,6 +1369,34 @@ compare_actual_formal (gfc_actual_arglis
 	  return 0;
 	}
 
+       if (a->expr->ts.type == BT_CHARACTER
+	   && a->expr->ts.cl && a->expr->ts.cl->length
+	   && a->expr->ts.cl->length->expr_type == EXPR_CONSTANT
+	   && f->sym->ts.cl && f->sym->ts.cl && f->sym->ts.cl->length
+	   && f->sym->ts.cl->length->expr_type == EXPR_CONSTANT)
+	 {
+	   if (mpz_cmp (a->expr->ts.cl->length->value.integer,
+			f->sym->ts.cl->length->value.integer) < 0)
+	     {
+		if (where)
+		  gfc_error ("Character length of actual argument shorter "
+			     "than of dummy argument '%s' at %L",
+			     f->sym->name, &a->expr->where);
+		return 0;
+	     }
+
+	   if ((f->sym->attr.pointer || f->sym->attr.allocatable)
+	       && (mpz_cmp (a->expr->ts.cl->length->value.integer,
+			   f->sym->ts.cl->length->value.integer) != 0))
+	     {
+		if (where)
+		  gfc_error ("Character length mismatch between actual argument "
+			     "and pointer or allocatable dummy argument "
+			     "'%s' at %L", f->sym->name, &a->expr->where);
+		return 0;
+	     }
+	 }
+
       /* Satisfy 12.4.1.2 by ensuring that a procedure actual argument is
 	 provided for a procedure formal argument.  */
       if (a->expr->ts.type != BT_PROCEDURE
Index: gcc/testsuite/gfortran.dg/char_length_3.f90
===================================================================
--- gcc/testsuite/gfortran.dg/char_length_3.f90	(revision 0)
+++ gcc/testsuite/gfortran.dg/char_length_3.f90	(revision 0)
@@ -0,0 +1,30 @@
+! { dg-do compile }
+! PR fortran/25071
+! Check if actual argument is too short
+!
+        program test
+           character(len=10) :: x
+           character(len=30), target :: y
+           character(len=30), pointer :: ptr
+           character(len=30), allocatable :: alloc(:)
+           ptr => y
+           call foo(x) ! { dg-error "actual argument shorter than of dummy" }
+           call foo(y)
+           call foo(ptr)
+           call bar(ptr) ! { dg-error "Character length mismatch" }
+           allocate(alloc(1))
+           call arr(alloc) ! { dg-error "Character length mismatch" }
+        contains
+        subroutine foo(y)
+           character(len=20) :: y
+           y = 'hello world'
+        end subroutine
+        subroutine bar(y)
+           character(len=20),pointer :: y
+           y = 'hello world'
+        end subroutine
+        subroutine arr(y)
+           character(len=20),allocatable :: y(:)
+           y(1) = 'hello world'
+        end subroutine
+       end
Index: gcc/testsuite/gfortran.dg/char_result_2.f90
===================================================================
--- gcc/testsuite/gfortran.dg/char_result_2.f90	(revision 124381)
+++ gcc/testsuite/gfortran.dg/char_result_2.f90	(working copy)
@@ -42,9 +42,11 @@ program main
   character (len = 80) :: text
   character (len = 70), target :: textt
   character (len = 70), pointer :: textp
+  character (len = 50), pointer :: textp2
 
   a = 42
   textp => textt
+  ! textp2 => textt(1:50) ! needs fixed PR31803
 
   call test (f1 (textp), 70)
   call test (f2 (textp, textp), 95)
@@ -53,7 +55,7 @@ program main
   call test (f5 (textp), 140)
   call test (f6 (textp), 29)
 
-  call indirect (textp)
+  ! call indirect (textp2) ! needs fixed PR31803
 contains
   function f3 (string)
     integer, parameter :: l1 = 30
@@ -93,7 +95,7 @@ contains
     call test (f1 (textp2), 50)
     call test (f2 (textp2, textp), 65)
     call test (f3 (textp2), 85)
-    call test (f4 (textp2), 192)
+!    call test (f4 (textp2), 192) ! invalid: actual leng 50 < formal len 70
     call test (f5 (textp2), 100)
     call test (f6 (textp2), 9)
   end subroutine indirect

Index Nav: [Date Index] [Subject Index] [Author Index] [Thread Index]
Message Nav: [Date Prev] [Date Next] [Thread Prev] [Thread Next]