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

[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

[Paul Richard Thomas]

Dear Steve,

This is OK to commit.

Thanks for the patch

Paul

On 23 October 2015 at 21:29, Steve Kargl
 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

[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  

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  

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

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

[Steve Kargl]

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
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 ();
   gfc_new_undo_checkpoint (changed_syms);
-  if (gfc_match_type_spec () == MATCH_YES)
+  m = gfc_match_type_spec ();
+  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
===
---