re PR libfortran/69651 ([6 Regession] Usage of unitialized pointer io/list_read.c)

2016-02-15  Jerry DeLisle  <jvdelisle@gcc.gnu.org>

	PR libgfortran/69651
	* io/list_read.c: Entire file trailing spaces removed.
	(CASE_SEPARATORS): Remove '!'.
	(is_separator): Add namelist mode as condition with '!'.
	(push_char): Remove un-needed memset. (push_char4): Likewise and remove
	'new' pointer. (eat_separator): Remove un-needed use of notify_std.
	(read_logical): If '!' bang encountered when not in namelist mode got
	bad_logical to give an error. (read_integer): Likewise reject '!'.
	(read_character): Remove condition testing c = '!' which is now inside
	the is_separator macro. (parse_real): Reject '!' unless in namelist mode.
	(read_complex): Reject '!' unless in namelist mode. (read_real): Likewise
	reject '!'.

	PR libgfortran/69651
	* gfortran.dg/read_bang.f90: New test.
	* gfortran.dg/read_bang4.f90: New test.

From-SVN: r233436

gcc/testsuite/ChangeLog

@@ -1,3 +1,9 @@
+2016-02-15  Jerry DeLisle  <jvdelisle@gcc.gnu.org>
+
+	PR libgfortran/69651
+	* gfortran.dg/read_bang.f90: New test.
+	* gfortran.dg/read_bang4.f90: New test.
+
 2016-02-15  Jakub Jelinek  <jakub@redhat.com>
 
 	PR c++/69658

gcc/testsuite/gfortran.dg/read_bang.f90

@@ -0,0 +1,38 @@
+! { dg-do run }
+! PR69651 Usage of unitialized pointer io/list_read.c 
+! Note: The uninitialized pointer was not the cause of the problem
+!       observed with this test case. The problem was mishandling '!'
+!       See also test case read_bang4.f90.
+program test
+  implicit none
+  integer :: i, j, ios
+  real ::  r, s
+  complex :: c, d
+  character(20) :: str1, str2
+  
+  i = -5
+  j = -6
+  r = -3.14
+  s = -2.71
+  c = (-1.1,-2.2)
+  d = (-3.3,-4.4)
+  str1 = "candy"
+  str2 = "peppermint"
+  open(15, status='scratch')
+  write(15,*) "10  1!2"
+  write(15,*) "  23.5! 34.5"
+  write(15,*) "  (67.50,69.25)  (51.25,87.75)!"
+  write(15,*) "  'abcdefgh!' '  !klmnopq!'"
+  rewind(15)
+  read(15,*,iostat=ios) i, j
+  if (ios.ne.5010) call abort
+  read(15,*,iostat=ios) r, s
+  if (ios.ne.5010) call abort
+  read(15,*,iostat=ios) c, d
+  if (ios.ne.5010) call abort
+  read(15,*,iostat=ios) str1, str2
+  if (ios.ne.0) call abort
+  if (str1.ne."abcdefgh!") print *, str1
+  if (str2.ne."  !klmnopq!") print *, str2
+  close(15)
+end program

gcc/testsuite/gfortran.dg/read_bang4.f90

@@ -0,0 +1,47 @@
+! { dg-do run }
+! PR69651 Usage of unitialized pointer io/list_read.c 
+! Note: The uninitialized pointer was not the cause of the problem
+!       observed with this test case. This tests the case with UTF-8
+!       files. The large string test the realloc use in push_char4 of
+!       list_read.c
+program test
+  implicit none
+  integer :: i, j, k, ios
+  integer, parameter :: big = 600
+  real ::  r, s
+  complex :: c, d
+  character(kind=4,len=big) :: str1, str2, str3
+
+  do i=1,big, 10
+    do j = 0, 9
+      k = i + j
+      str2(k:k) = char(65+j)
+    end do
+  end do
+  i = -5
+  j = -6
+  r = -3.14
+  s = -2.71
+  c = (-1.1,-2.2)
+  d = (-3.3,-4.4)
+  str3 = str2
+  open(15, status='scratch', encoding="utf-8")
+  write(15,*) "10  1!2"
+  write(15,*) "  23.5! 34.5"
+  write(15,*) "  (67.50,69.25)  (51.25,87.75)!"
+  write(15,*) "  'abcdefgh!'", " ", str2
+  rewind(15)
+  str1 = 4_"candy"
+  str2 = 4_"peppermint"
+  read(15,*,iostat=ios) i, j
+  if (ios.ne.5010) call abort
+  read(15,*,iostat=ios) r, s
+  if (ios.ne.5010) call abort
+  read(15,*,iostat=ios) c, d
+  if (ios.ne.5010) call abort
+  read(15,*,iostat=ios) str1, str2
+  if (ios.ne.0) call abort
+  if (str1.ne.4_"abcdefgh!") call abort
+  if (str2.ne.str3) call abort
+  close(15)
+end program

libgfortran/ChangeLog

@@ -1,3 +1,18 @@
+2016-02-15  Jerry DeLisle  <jvdelisle@gcc.gnu.org>
+
+	PR libgfortran/69651
+	* io/list_read.c: Entire file trailing spaces removed.
+	(CASE_SEPARATORS): Remove '!'.
+	(is_separator): Add namelist mode as condition with '!'.
+	(push_char): Remove un-needed memset. (push_char4): Likewise and remove
+	'new' pointer. (eat_separator): Remove un-needed use of notify_std.
+	(read_logical): If '!' bang encountered when not in namelist mode got
+	bad_logical to give an error. (read_integer): Likewise reject '!'.
+	(read_character): Remove condition testing c = '!' which is now inside
+	the is_separator macro. (parse_real): Reject '!' unless in namelist mode.
+	(read_complex): Reject '!' unless in namelist mode. (read_real): Likewise
+	reject '!'. 
+
 2016-02-12  Jerry DeLisle  <jvdelisle@gcc.gnu.org>
 
 	PR libgfortran/69668

libgfortran/io/list_read.c

@@ -52,13 +52,14 @@ typedef unsigned char uchar;
 #define CASE_DIGITS   case '0': case '1': case '2': case '3': case '4': \
                       case '5': case '6': case '7': case '8': case '9'
 
-#define CASE_SEPARATORS  case ' ': case ',': case '/': case '\n': case '\t': \
+#define CASE_SEPARATORS case ' ': case ',': case '/': case '\n': \
-                         case '\r': case ';': case '!'
+			case '\t': case '\r': case ';'
 
 /* This macro assumes that we're operating on a variable.  */
 
 #define is_separator(c) (c == '/' ||  c == ',' || c == '\n' || c == ' ' \
-                         || c == '\t' || c == '\r' || c == ';' || c == '!')
+                         || c == '\t' || c == '\r' || c == ';' || \
+			 (dtp->u.p.namelist_mode && c == '!'))
 
 /* Maximum repeat count.  Less than ten times the maximum signed int32.  */
 
@@ -94,11 +95,6 @@ push_char_default (st_parameter_dt *dtp, int c)
       dtp->u.p.saved_length = 2 * dtp->u.p.saved_length;
       dtp->u.p.saved_string =
 	xrealloc (dtp->u.p.saved_string, dtp->u.p.saved_length);
-      
-      // Also this should not be necessary.
-      memset (dtp->u.p.saved_string + dtp->u.p.saved_used, 0, 
-	      dtp->u.p.saved_length - dtp->u.p.saved_used);
-
     }
 
   dtp->u.p.saved_string[dtp->u.p.saved_used++] = (char) c;
@@ -107,11 +103,10 @@ push_char_default (st_parameter_dt *dtp, int c)
 
 /* Worker function to save a KIND=4 character to a string buffer,
    enlarging the buffer as necessary.  */
-   
 static void
 push_char4 (st_parameter_dt *dtp, int c)
 {
-  gfc_char4_t *new, *p = (gfc_char4_t *) dtp->u.p.saved_string;
+  gfc_char4_t *p = (gfc_char4_t *) dtp->u.p.saved_string;
 
   if (p == NULL)
     {
@@ -125,9 +120,6 @@ push_char4 (st_parameter_dt *dtp, int c)
     {
       dtp->u.p.saved_length = 2 * dtp->u.p.saved_length;
       p = xrealloc (p, dtp->u.p.saved_length * sizeof (gfc_char4_t));
-      
-      memset4 (new + dtp->u.p.saved_used, 0, 
-	      dtp->u.p.saved_length - dtp->u.p.saved_used);
     }
 
   p[dtp->u.p.saved_used++] = c;
@@ -521,11 +513,9 @@ eat_separator (st_parameter_dt *dtp)
       break;
 
     case '!':
+      /* Eat a namelist comment.  */
       if (dtp->u.p.namelist_mode)
-	{			/* Eat a namelist comment.  */
+	{
-	  notify_std (&dtp->common, GFC_STD_GNU,
-		      "'!' in namelist is not a valid separator,"
-		      " try inserting a space");
 	  err = eat_line (dtp);
 	  if (err)
 	    return err;
@@ -855,6 +845,10 @@ read_logical (st_parameter_dt *dtp, int length)
 
       break;
 
+    case '!':
+      if (!dtp->u.p.namelist_mode)
+        goto bad_logical;
+
     CASE_SEPARATORS:
     case EOF:
       unget_char (dtp, c);
@@ -974,6 +968,10 @@ read_integer (st_parameter_dt *dtp, int length)
 	goto bad_integer;
       goto get_integer;
 
+    case '!':
+      if (!dtp->u.p.namelist_mode)
+        goto bad_integer;
+
     CASE_SEPARATORS:		/* Single null.  */
       unget_char (dtp, c);
       eat_separator (dtp);
@@ -1002,6 +1000,10 @@ read_integer (st_parameter_dt *dtp, int length)
 	  push_char (dtp, '\0');
 	  goto repeat;
 
+	case '!':
+	  if (!dtp->u.p.namelist_mode)
+	    goto bad_integer;
+
 	CASE_SEPARATORS:	/* Not a repeat count.  */
 	case EOF:
 	  goto done;
@@ -1024,6 +1026,10 @@ read_integer (st_parameter_dt *dtp, int length)
     CASE_DIGITS:
       break;
 
+    case '!':
+      if (!dtp->u.p.namelist_mode)
+        goto bad_integer;
+
     CASE_SEPARATORS:
       unget_char (dtp, c);
       eat_separator (dtp);
@@ -1052,6 +1058,10 @@ read_integer (st_parameter_dt *dtp, int length)
 	  push_char (dtp, c);
 	  break;
 
+	case '!':
+	  if (!dtp->u.p.namelist_mode)
+	    goto bad_integer;
+
 	CASE_SEPARATORS:
 	case EOF:
 	  goto done;
@@ -1241,7 +1251,7 @@ read_character (st_parameter_dt *dtp, int length __attribute__ ((unused)))
  done:
   c = next_char (dtp);
  done_eof:
-  if (is_separator (c) || c == '!' || c == EOF)
+  if (is_separator (c) || c == EOF)
     {
       unget_char (dtp, c);
       eat_separator (dtp);
@@ -1335,6 +1345,10 @@ parse_real (st_parameter_dt *dtp, void *buffer, int length)
 	    goto bad;
 	  goto exp2;
 
+	case '!':
+	  if (!dtp->u.p.namelist_mode)
+	    goto bad;
+
 	CASE_SEPARATORS:
 	case EOF:
 	  goto done;
@@ -1371,6 +1385,10 @@ parse_real (st_parameter_dt *dtp, void *buffer, int length)
 	  push_char (dtp, c);
 	  break;
 
+	case '!':
+	  if (!dtp->u.p.namelist_mode)
+	    goto bad;
+
 	CASE_SEPARATORS:
 	case EOF:
 	  unget_char (dtp, c);
@@ -1488,6 +1506,10 @@ read_complex (st_parameter_dt *dtp, void * dest, int kind, size_t size)
     case '(':
       break;
 
+    case '!':
+      if (!dtp->u.p.namelist_mode)
+	goto bad_complex;
+
     CASE_SEPARATORS:
     case EOF:
       unget_char (dtp, c);
@@ -1606,6 +1628,10 @@ read_real (st_parameter_dt *dtp, void * dest, int length)
     case '-':
       goto got_sign;
 
+    case '!':
+      if (!dtp->u.p.namelist_mode)
+	goto bad_real;
+
     CASE_SEPARATORS:
       unget_char (dtp, c);		/* Single null.  */
       eat_separator (dtp);
@@ -1661,6 +1687,10 @@ read_real (st_parameter_dt *dtp, void * dest, int length)
 	  push_char (dtp, '\0');
 	  goto got_repeat;
 
+	case '!':
+	  if (!dtp->u.p.namelist_mode)
+	    goto bad_real;
+
 	CASE_SEPARATORS:
 	case EOF:
           if (c != '\n' && c != ',' && c != '\r' && c != ';')
@@ -1730,6 +1760,10 @@ read_real (st_parameter_dt *dtp, void * dest, int length)
 	  push_char (dtp, c);
 	  break;
 
+	case '!':
+	  if (!dtp->u.p.namelist_mode)
+	    goto bad_real;
+
 	CASE_SEPARATORS:
 	case EOF:
 	  goto done;
@@ -1790,6 +1824,10 @@ read_real (st_parameter_dt *dtp, void * dest, int length)
 	  push_char (dtp, c);
 	  break;
 
+	case '!':
+	  if (!dtp->u.p.namelist_mode)
+	    goto bad_real;
+
 	CASE_SEPARATORS:
 	case EOF:
 	  goto done;