On 02/01/2015 01:02 PM, Tobias Burnus wrote:
Jerry DeLisle wrote:
The attached patch fixes this issue.
Regression tested on x86-64.
New test case attached.

OK for trunk?
Looks ok (together with a changelog for the test case).

However, I tried a similar fixed-form program and it failed similarly. I think
you need a similar fix (in the same function) for fixed-form source code. See
attachment for an example.

Tobias


Here is an updated patch that addresses the fixed form source example you 
provided.

Also regression tested with no failures.

I have an additional test case attached and will do a ChangeLog for the test 
cases.

OK?

Regards,

Jerry

2015-02-01  Jerry DeLisle  <jvdeli...@gcc.gnu.org>

        PR fortran/64506
        * scanner.c (gfc_next_char_literal): For free form source,
        check for '!' and if found, clear the comment and go back
        and get the next character. For fixed form source, skip the
        rest of the line.
Index: scanner.c
===================================================================
--- scanner.c	(revision 220315)
+++ scanner.c	(working copy)
@@ -1268,13 +1268,25 @@
 	c = next_char ();
 
       /* Character constants to be continued cannot have commentary
-	 after the '&'.  */
+	 after the '&'. However, there are cases where we may think we
+	 are still in a string and we are looking for a possible
+	 doubled quote and we end up here. See PR64506.  */
 
-      if (in_string && c != '\n')
+      if (in_string)
 	{
 	  gfc_current_locus = old_loc;
-	  c = '&';
-	  goto done;
+
+	  if (c == '!')
+	    {
+	      skip_comment_line ();
+	      goto restart;
+	    }
+
+	  if (c != '\n')
+	    {
+	      c = '&';
+	      goto done;
+	    }
 	}
 
       if (c != '!' && c != '\n')
@@ -1395,7 +1407,7 @@
   else /* Fixed form.  */
     {
       /* Fixed form continuation.  */
-      if (!in_string && c == '!')
+      if (in_string != INSTRING_WARN && c == '!')
 	{
 	  /* Skip comment at end of line.  */
 	  do
! { dg-do run }
! { dg-options "-std=gnu" }
! PR64506 fixed form source
      character(25) :: astring

 100  format('This format is OK.'
     &)
 200  format('This format works now.'!comment << FAILS
     &)
 300  format('This format is OK.' !comment
     &)
 400  format('This format is OK.'  !comment
     &)
 500  format('This format is now OK.'''!comment
     &   )
 600  format('This format is OK.''' !comment
     &   )
      write(astring,100)
      if (astring.ne."This format is OK.") print *, astring
      write(astring,200)
      if (astring.ne."This format works now.") print *, astring
      write(astring,300)
      if (astring.ne."This format is OK.") print *, astring
      write(astring,400)
      if (astring.ne."This format is OK.") print *, astring
      write(astring,500)
      if (astring.ne."This format is now OK.'") print *, astring
      write(astring,600)
      if (astring.ne."This format is OK.'") print *, astring
      end

Reply via email to