Re: [PATCH] PR fortran/67805 -- Check for invalid charlength

Re: [PATCH] PR fortran/67805 -- Check for invalid charlength

[Dominique d'Humières]

At revision r229288 compiling the following test

  implicit none

  type :: template_t
     integer :: type
     character(256) :: charset1, charset2
     integer :: len1, len2
  end type template_t

contains

  subroutine match_quoted (tt, s, n, range)
    type(template_t), intent(in) :: tt
    character(*), intent(in) :: s
    integer, intent(out) :: n
    integer, dimension(2), intent(out) :: range
    character(tt%len1) :: ch1
    character(tt%len2) :: ch2
    integer :: i
    ch1 = tt%charset1
    if (s(1:tt%len1) == ch1) then
       ch2 = tt%charset2
       do i = tt%len1 + 1, len (s) - tt%len2 + 1
          if (s(i:i+tt%len2-1) == ch2) then
             n = i + tt%len2 - 1
             range(1) = tt%len1 + 1
             range(2) = i - 1
             return
          end if
       end do
       n = -1
       range = 0
    else
       n = 0
       range = 0
    end if
  end subroutine match_quoted

end

gives the following errors

pr40440_red_1.f90:16:14:

     character(tt%len1) :: ch1
              1
Error: Scalar INTEGER expression expected at (1)
pr40440_red_1.f90:17:14:

     character(tt%len2) :: ch2
              1
Error: Scalar INTEGER expression expected at (1)
pr40440_red_1.f90:19:7:

     ch1 = tt%charset1
       1
Error: Symbol 'ch1' at (1) has no IMPLICIT type
pr40440_red_1.f90:21:10:

        ch2 = tt%charset2
          1
Error: Symbol 'ch2' at (1) has no IMPLICIT type

while it compiles without error at r229261.

TIA

Dominique

Re: [PATCH] PR fortran/67805 -- Check for invalid charlength

[Mikael Morin]

Le 24/10/2015 21:29, Dominique d'Humières a écrit :
> At revision r229288 compiling the following test
>
[...]
>
> while it compiles without error at r229261.
>
I believe the accesses to ref->u.ar should be guarded with ref->type == 
REF_ARRAY.
Steve, a patch doing that is preapproved.

Mikael

Re: [PATCH] PR fortran/67805 -- Check for invalid charlength

[Paul Richard Thomas]

Dear Steve,

This is OK to commit.

Thanks for the patch

Paul

On 23 October 2015 at 21:29, Steve Kargl
<sgk@troutmask.apl.washington.edu> wrote:
> On Fri, Oct 23, 2015 at 12:28:14PM -0700, Steve Kargl wrote:
>> Built and regression tested on x86_64-*-freebsd.
>> OK to commit?
>>
>
> Now with the patch attached!
>
> --
> Steve



-- 
Outside of a dog, a book is a man's best friend. Inside of a dog it's
too dark to read.

Groucho Marx

Re: [PATCH] PR fortran/67805 -- Check for invalid charlength

[Steve Kargl]

[-- Attachment #1: Type: text/plain, Size: 172 bytes --]

On Fri, Oct 23, 2015 at 12:28:14PM -0700, Steve Kargl wrote:
> Built and regression tested on x86_64-*-freebsd.
> OK to commit?
> 

Now with the patch attached!

-- 
Steve

[-- Attachment #2: pr67805.diff --]
[-- Type: text/x-diff, Size: 10243 bytes --]

Index: gcc/fortran/array.c
===================================================================
--- gcc/fortran/array.c	(revision 229265)
+++ gcc/fortran/array.c	(working copy)
@@ -1080,7 +1080,8 @@ gfc_match_array_constructor (gfc_expr **
   /* Try to match an optional "type-spec ::"  */
   gfc_clear_ts (&ts);
   gfc_new_undo_checkpoint (changed_syms);
-  if (gfc_match_type_spec (&ts) == MATCH_YES)
+  m = gfc_match_type_spec (&ts);
+  if (m == MATCH_YES)
     {
       seen_ts = (gfc_match (" ::") == MATCH_YES);
 
@@ -1102,6 +1103,11 @@ gfc_match_array_constructor (gfc_expr **
 	    }
 	}
     }
+  else if (m == MATCH_ERROR)
+    {
+      gfc_restore_last_undo_checkpoint ();
+      goto cleanup;
+    }
 
   if (seen_ts)
     gfc_drop_last_undo_checkpoint ();
Index: gcc/fortran/decl.c
===================================================================
--- gcc/fortran/decl.c	(revision 229265)
+++ gcc/fortran/decl.c	(working copy)
@@ -715,36 +715,59 @@ char_len_param_value (gfc_expr **expr, b
 
   if ((*expr)->expr_type == EXPR_FUNCTION)
     {
-      if ((*expr)->value.function.actual
-	  && (*expr)->value.function.actual->expr->symtree)
+      if ((*expr)->ts.type == BT_INTEGER
+	  || ((*expr)->ts.type == BT_UNKNOWN
+	      && strcmp((*expr)->symtree->name, "null") != 0))
+	return MATCH_YES;
+
+      goto syntax;
+    }
+  else if ((*expr)->expr_type == EXPR_CONSTANT)
+    {
+      /* F2008, 4.4.3.1:  The length is a type parameter; its kind is
+	 processor dependent and its value is greater than or equal to zero.
+	 F2008, 4.4.3.2:  If the character length parameter value evaluates
+	 to a negative value, the length of character entities declared
+	 is zero.  */
+
+      if ((*expr)->ts.type == BT_INTEGER)
 	{
-	  gfc_expr *e;
-	  e = (*expr)->value.function.actual->expr;
-	  if (e->symtree->n.sym->attr.flavor == FL_PROCEDURE
-	      && e->expr_type == EXPR_VARIABLE)
-	    {
-	      if (e->symtree->n.sym->ts.type == BT_UNKNOWN)
-		goto syntax;
-	      if (e->symtree->n.sym->ts.type == BT_CHARACTER
-		  && e->symtree->n.sym->ts.u.cl
-		  && e->symtree->n.sym->ts.u.cl->length->ts.type == BT_UNKNOWN)
-	        goto syntax;
-	    }
+	  if (mpz_cmp_si ((*expr)->value.integer, 0) < 0)
+	    mpz_set_si ((*expr)->value.integer, 0);
 	}
+      else
+	goto syntax;
     }
+  else if ((*expr)->expr_type == EXPR_ARRAY)
+    goto syntax;
+  else if ((*expr)->expr_type == EXPR_VARIABLE)
+    {
+      gfc_expr *e;
+
+      e = gfc_copy_expr (*expr);
+
+      /* This catches the invalid code "[character(m(2:3)) :: 'x', 'y']",
+	 which causes an ICE if gfc_reduce_init_expr() is called.  */
+      if (e->ref && e->ref->u.ar.type == AR_UNKNOWN
+	  && e->ref->u.ar.dimen_type[0] == DIMEN_RANGE)
+	goto syntax;
+
+      gfc_reduce_init_expr (e);
+
+      if ((e->ref && e->ref->u.ar.type != AR_ELEMENT) 
+	  || (!e->ref && e->expr_type == EXPR_ARRAY))
+	{
+	  gfc_free_expr (e);
+	  goto syntax;
+	}
 
-  /* F2008, 4.4.3.1:  The length is a type parameter; its kind is processor
-     dependent and its value is greater than or equal to zero.
-     F2008, 4.4.3.2:  If the character length parameter value evaluates to
-     a negative value, the length of character entities declared is zero.  */
-  if ((*expr)->expr_type == EXPR_CONSTANT
-      && mpz_cmp_si ((*expr)->value.integer, 0) < 0)
-    mpz_set_si ((*expr)->value.integer, 0);
+      gfc_free_expr (e);
+    }
 
   return m;
 
 syntax:
-  gfc_error ("Conflict in attributes of function argument at %C");
+  gfc_error ("Scalar INTEGER expression expected at %L", &(*expr)->where);
   return MATCH_ERROR;
 }
 
Index: gcc/fortran/match.c
===================================================================
--- gcc/fortran/match.c	(revision 229265)
+++ gcc/fortran/match.c	(working copy)
@@ -1939,6 +1939,11 @@ kind_selector:
   if (m == MATCH_NO)
     m = MATCH_YES;		/* No kind specifier found.  */
 
+  /* gfortran may have matched REAL(a=1), which is the keyword form of the
+     intrinsic procedure.  */
+  if (ts->type == BT_REAL && m == MATCH_ERROR)
+    m = MATCH_NO;
+
   return m;
 }
 
Index: gcc/testsuite/gfortran.dg/array_constructor_26.f03
===================================================================
--- gcc/testsuite/gfortran.dg/array_constructor_26.f03	(revision 229265)
+++ gcc/testsuite/gfortran.dg/array_constructor_26.f03	(working copy)
@@ -11,7 +11,6 @@ MODULE WinData
   integer :: i
   TYPE TWindowData
     CHARACTER (MAX_FLD_HED, 1) :: DWFdHd(MAXFLD) = [(" ", i = 1, MAXFLD)]
-    ! { dg-error "no IMPLICIT type" "" { target *-*-* } 13 }
     ! { dg-error "specification expression" "" { target *-*-* } 13 }
   END TYPE TWindowData
 END MODULE WinData
Index: gcc/testsuite/gfortran.dg/array_constructor_27.f03
===================================================================
--- gcc/testsuite/gfortran.dg/array_constructor_27.f03	(revision 229265)
+++ gcc/testsuite/gfortran.dg/array_constructor_27.f03	(working copy)
@@ -9,7 +9,6 @@ implicit none
 
 type t
   character (a) :: arr (1) = [ "a" ]
-  ! { dg-error "no IMPLICIT type" "" { target *-*-* } 11 }
   ! { dg-error "specification expression" "" { target *-*-* } 11 }
 end type t
 
Index: gcc/testsuite/gfortran.dg/char_type_len_2.f90
===================================================================
--- gcc/testsuite/gfortran.dg/char_type_len_2.f90	(revision 229265)
+++ gcc/testsuite/gfortran.dg/char_type_len_2.f90	(working copy)
@@ -1,8 +1,11 @@
 ! { dg-do compile }
 ! PR31251 Non-integer character length leads to segfault
 ! Submitted by Jerry DeLisle  <jvdelisle@gcc.gnu.org>
-  character(len=2.3) :: s ! { dg-error "must be of INTEGER type" }
-  character(kind=1,len=4.3) :: t ! { dg-error "must be of INTEGER type" }
+!
+! Updated to deal with the fix for PR fortran/67805.
+!
+  character(len=2.3) :: s ! { dg-error "INTEGER expression expected" }
+  character(kind=1,len=4.3) :: t ! { dg-error "INTEGER expression expected" }
   character(len=,,7.2,kind=1) :: u ! { dg-error "Syntax error in CHARACTER declaration" }
   character(len=7,kind=2) :: v ! ! { dg-error "Kind 2 is not supported for CHARACTER" }
   character(kind=2) :: w ! ! { dg-error "Kind 2 is not supported for CHARACTER" }
Index: gcc/testsuite/gfortran.dg/pr67802.f90
===================================================================
--- gcc/testsuite/gfortran.dg/pr67802.f90	(revision 229265)
+++ gcc/testsuite/gfortran.dg/pr67802.f90	(working copy)
@@ -2,8 +2,8 @@
 ! PR fortran/67802
 ! Original code contribute by gerhard.steinmetz.fortran at t-online.de
 program p
-   character(1.) :: c1 = ' '      ! { dg-error "must be of INTEGER" }
-   character(1d1) :: c2 = ' '     ! { dg-error "must be of INTEGER" }
-   character((0.,1.)) :: c3 = ' ' ! { dg-error "must be of INTEGER" }
-   character(.true.) :: c4 = ' '  ! { dg-error "must be of INTEGER" }
+   character(1.) :: c1 = ' '      ! { dg-error "INTEGER expression expected" }
+   character(1d1) :: c2 = ' '     ! { dg-error "INTEGER expression expected" }
+   character((0.,1.)) :: c3 = ' ' ! { dg-error "INTEGER expression expected" }
+   character(.true.) :: c4 = ' '  ! { dg-error "INTEGER expression expected" }
 end program p
Index: gcc/testsuite/gfortran.dg/pr67805.f90
===================================================================
--- gcc/testsuite/gfortran.dg/pr67805.f90	(revision 0)
+++ gcc/testsuite/gfortran.dg/pr67805.f90	(working copy)
@@ -0,0 +1,37 @@
+! { dg-do compile }
+! PR fortran/67805
+! Original code contributed by Gerhard Steinmetz
+! gerhard dot steinmetz dot fortran at t-online dot de
+!
+subroutine p
+   integer, parameter :: n = 1
+   integer, parameter :: m(3) = [1, 2, 3]
+   character(len=1) s(2)
+   s = [character((m(1))) :: 'x', 'y']    ! OK.
+   s = [character(m(1)) :: 'x', 'y']      ! OK.
+   s = [character(m) :: 'x', 'y']         ! { dg-error "INTEGER expression expected" }
+   
+   ! The next line should case an error, but causes an ICE. 
+   s = [character(m(2:3)) :: 'x', 'y']    ! { dg-error "INTEGER expression expected" }
+   
+   call foo(s)
+   s = [character('') :: 'x', 'y']        ! { dg-error "INTEGER expression expected" }
+   s = [character(['']) :: 'x', 'y']      ! { dg-error "INTEGER expression expected" }
+   s = [character([.true.]) :: 'x', 'y']  ! { dg-error "INTEGER expression expected" }
+   s = [character([.false.]) :: 'x', 'y'] ! { dg-error "INTEGER expression expected" }
+   s = [character([1.]) :: 'x', 'y']      ! { dg-error "INTEGER expression expected" }
+   s = [character([1d1]) :: 'x', 'y']     ! { dg-error "INTEGER expression expected" }
+   s = [character([(0.,1.)]) :: 'x', 'y'] ! { dg-error "INTEGER expression expected" }
+   s = [character([null()]) :: 'x', 'y']  ! { dg-error "INTEGER expression expected" }
+   s =  [character(null()) :: 'x', 'y']   ! { dg-error "INTEGER expression expected" }
+   call foo(s)
+end subroutine p
+
+subroutine q
+   print *, '1: ', [character(.true.) :: 'x', 'y']  ! { dg-error "INTEGER expression expected" }
+   print *, '2: ', [character(.false.) :: 'x', 'y'] ! { dg-error "INTEGER expression expected" }
+   print *, '3: ', [character(1.) :: 'x', 'y']      ! { dg-error "INTEGER expression expected" }
+   print *, '4: ', [character(1d1) :: 'x', 'y']     ! { dg-error "INTEGER expression expected" }
+   print *, '5: ', [character((0.,1.)) :: 'x', 'y'] ! { dg-error "INTEGER expression expected" }
+   print *, '6: ', [character(null()) :: 'x', 'y']  ! { dg-error "INTEGER expression expected" }.
+end subroutine q
Index: gcc/testsuite/gfortran.dg/used_before_typed_3.f90
===================================================================
--- gcc/testsuite/gfortran.dg/used_before_typed_3.f90	(revision 229265)
+++ gcc/testsuite/gfortran.dg/used_before_typed_3.f90	(working copy)
@@ -17,14 +17,14 @@ CONTAINS
     test1 = "foobar"
   END FUNCTION test1
 
-  CHARACTER(len=x) FUNCTION test2 (x) ! { dg-bogus "used before|of INTEGER" }
+  CHARACTER(len=x) FUNCTION test2 (x) ! { dg-error "of INTEGER" }
     IMPLICIT INTEGER(a-z)
     test2 = "foobar"
   END FUNCTION test2
 
 END MODULE testmod
   
-CHARACTER(len=i) FUNCTION test3 (i) ! { dg-bogus "used before|of INTEGER" }
+CHARACTER(len=i) FUNCTION test3 (i)
   ! i is IMPLICIT INTEGER by default
   test3 = "foobar"
 END FUNCTION test3

[PATCH] PR fortran/67805 -- Check for invalid charlength

[Steve Kargl]

All,

The attached patch fixes several ICEs caused by invalid
charlengths.  The new testcase pr67805.f90 shows the 
kinds of issues the patch will detect.  An appropriate
error message is now issued.

Built and regression tested on x86_64-*-freebsd.
OK to commit?

2015-10-23  Steven G. Kargl  <kargl@gcc.gnu.org>

	PR fortran/67805
	* array.c (gfc_match_array_constructor): Check for error from type
	spec matching.
	* decl.c (char_len_param_value): Check for valid of charlen parameter.
	Reap dead code dating to 2008.
	match.c (gfc_match_type_spec): Special case the keyword use in REAL.

2015-10-23  Steven G. Kargl  <kargl@gcc.gnu.org>

	PR fortran/67805
	* gfortran.dg/pr67805.f90: New testcase.
	* gfortran.dg/array_constructor_26.f03: Update testcase.
	* gfortran.dg/array_constructor_27.f03: Ditto.
	* gfortran.dg/char_type_len_2.f90: Ditto.
	* gfortran.dg/pr67802.f90: Ditto.
	* gfortran.dg/used_before_typed_3.f90: Ditto.

-- 
Steve