[multiple changes]
authorPaul Thomas <pault@gcc.gnu.org>
Thu, 28 Jul 2016 14:47:02 +0000 (14:47 +0000)
committerPaul Thomas <pault@gcc.gnu.org>
Thu, 28 Jul 2016 14:47:02 +0000 (14:47 +0000)
2016-07-28  Steven G. Kargl  <kargl@gcc.gnu.org>
    Thomas Koenig  <tkoenig@gcc.gnu.org>

PR fortran/71883
* frontend-passes.c (gfc_run_passes): Bail out if there are any
errors.
* error.c (gfc_internal_error): If there are any errors in the
buffer, exit with EXIT_FAILURE.

2016-07-28  Paul Thomas  <pault@gcc.gnu.org>

PR fortran/71883
* gfortran.dg/pr71883.f90 : New test.

From-SVN: r238822

gcc/fortran/ChangeLog
gcc/fortran/error.c
gcc/fortran/frontend-passes.c
gcc/testsuite/ChangeLog
gcc/testsuite/gfortran.dg/pr71883.f90 [new file with mode: 0644]

index 5baf3982c5e296fa874abf7eab8986a9f5a39877..85f2107e35e9cddde95ec4b5468a6144fe262b31 100644 (file)
@@ -1,3 +1,12 @@
+2016-07-28  Steven G. Kargl  <kargl@gcc.gnu.org>
+           Thomas Koenig  <tkoenig@gcc.gnu.org>
+
+       PR fortran/71883
+       * frontend-passes.c (gfc_run_passes): Bail out if there are any
+       errors.
+       * error.c (gfc_internal_error): If there are any errors in the
+       buffer, exit with EXIT_FAILURE.
+
 2016-07-28  Renlin Li  <renlin.li@arm.com>
 
        Revert
@@ -19,7 +28,7 @@
 2016-07-22  Steven G. Kargl  <kargl@gcc.gnu.org>
 
        PR fortran/71935
-       * check.c (is_c_interoperable): Simplify right expression. 
+       * check.c (is_c_interoperable): Simplify right expression.
 
 2016-07-22  Thomas Koenig  <tkoenig@gcc.gnu.org>
 
@@ -75,7 +84,7 @@
 
        PR fortran/29819
        * parse.c (parse_contained): Use proper locus.
+
 2016-07-14  Andre Vehreschild  <vehre@gcc.gnu.org>
 
        PR fortran/70842
index 6cfe019e8aea24c1f0a8355386be6056b0da5427..acba1c874cc513af12045b40775b37a0f066b425 100644 (file)
@@ -307,7 +307,7 @@ show_locus (locus *loc, int c1, int c2)
 
   error_string (f->filename);
   error_char (':');
-    
+
   error_integer (LOCATION_LINE (lb->location));
 
   if ((c1 > 0) || (c2 > 0))
@@ -357,7 +357,7 @@ show_locus (locus *loc, int c1, int c2)
     offset = cmax - terminal_width + 5;
 
   /* Show the line itself, taking care not to print more than what can
-     show up on the terminal.  Tabs are converted to spaces, and 
+     show up on the terminal.  Tabs are converted to spaces, and
      nonprintable characters are converted to a "\xNN" sequence.  */
 
   p = &(lb->line[offset]);
@@ -375,7 +375,7 @@ show_locus (locus *loc, int c1, int c2)
   error_char ('\n');
 
   /* Show the '1' and/or '2' corresponding to the column of the error
-     locus.  Note that a value of -1 for c1 or c2 will simply cause 
+     locus.  Note that a value of -1 for c1 or c2 will simply cause
      the relevant number not to be printed.  */
 
   c1 -= offset;
@@ -440,7 +440,7 @@ show_loci (locus *l1, locus *l2)
   else
     m = c1 - c2;
 
-  /* Note that the margin value of 10 here needs to be less than the 
+  /* Note that the margin value of 10 here needs to be less than the
      margin of 5 used in the calculation of offset in show_locus.  */
 
   if (l1->lb != l2->lb || m > terminal_width - 10)
@@ -467,11 +467,11 @@ show_loci (locus *l1, locus *l2)
    If a locus pointer is given, the actual source line is printed out
    and the column is indicated.  Since we want the error message at
    the bottom of any source file information, we must scan the
-   argument list twice -- once to determine whether the loci are 
+   argument list twice -- once to determine whether the loci are
    present and record this for printing, and once to print the error
    message after and loci have been printed.  A maximum of two locus
    arguments are permitted.
-   
+
    This function is also called (recursively) by show_locus in the
    case of included files; however, as show_locus does not resupply
    any loci, the recursion is at most one level deep.  */
@@ -687,11 +687,11 @@ error_print (const char *type, const char *format0, va_list argp)
          /* This is a position specifier.  See comment above.  */
          while (ISDIGIT (*format))
            format++;
-           
+
          /* Skip over the dollar sign.  */
          format++;
        }
-       
+
       switch (*format)
        {
        case '%':
@@ -804,10 +804,10 @@ gfc_warning (int opt, const char *gmsgid, va_list ap)
        ++werrorcount;
       else if (diagnostic.kind == DK_ERROR)
        ++werrorcount_buffered;
-      else 
+      else
        ++werrorcount, --warningcount, ++warningcount_buffered;
     }
-  
+
   va_end (argp);
   return ret;
 }
@@ -1030,17 +1030,17 @@ gfc_diagnostic_build_locus_prefix (diagnostic_context *context,
    With -fdiagnostic-show-caret (the default) it prints:
 
        [locus of primary range]:
-       
+
           some code
                  1
        Error: Some error at (1)
-        
+
   With -fno-diagnostic-show-caret or if the primary range is not
   valid, it prints:
 
        [locus of primary range]: Error: Some error at (1) and (2)
 */
-static void 
+static void
 gfc_diagnostic_starter (diagnostic_context *context,
                        diagnostic_info *diagnostic)
 {
@@ -1051,7 +1051,7 @@ gfc_diagnostic_starter (diagnostic_context *context,
   bool one_locus = diagnostic->richloc->get_num_locations () < 2;
   bool same_locus = false;
 
-  if (!one_locus) 
+  if (!one_locus)
     {
       s2 = diagnostic_expand_location (diagnostic, 1);
       same_locus = diagnostic_same_line (context, s1, s2);
@@ -1223,8 +1223,8 @@ gfc_warning_check (void)
       werrorcount += werrorcount_buffered;
       gcc_assert (warningcount_buffered + werrorcount_buffered == 1);
       pp->buffer = tmp_buffer;
-      diagnostic_action_after_output (global_dc, 
-                                     warningcount_buffered 
+      diagnostic_action_after_output (global_dc,
+                                     warningcount_buffered
                                      ? DK_WARNING : DK_ERROR);
     }
 }
@@ -1303,10 +1303,15 @@ gfc_error (const char *gmsgid, ...)
 void
 gfc_internal_error (const char *gmsgid, ...)
 {
+  int e, w;
   va_list argp;
   diagnostic_info diagnostic;
   rich_location rich_loc (line_table, UNKNOWN_LOCATION);
 
+  gfc_get_errors (&w, &e);
+  if (e > 0)
+    exit(EXIT_FAILURE);
+
   va_start (argp, gmsgid);
   diagnostic_set_info (&diagnostic, gmsgid, &argp, &rich_loc, DK_ICE);
   report_diagnostic (&diagnostic);
@@ -1332,7 +1337,7 @@ gfc_clear_error (void)
 bool
 gfc_error_flag_test (void)
 {
-  return error_buffer.flag 
+  return error_buffer.flag
     || !gfc_output_buffer_empty_p (pp_error_buffer);
 }
 
index a543ab2d4c59615d9b21bbb64f3f90785bee7367..29e43a11138f9ff31acc5a0bca7ccd90300f59d8 100644 (file)
@@ -125,6 +125,7 @@ gfc_run_passes (gfc_namespace *ns)
   doloop_level = 0;
   doloop_warn (ns);
   doloop_list.release ();
+  int w, e;
 
   if (flag_frontend_optimize)
     {
@@ -136,6 +137,10 @@ gfc_run_passes (gfc_namespace *ns)
       expr_array.release ();
     }
 
+  gfc_get_errors (&w, &e);
+  if (e > 0)
+   return;
+
   if (flag_realloc_lhs)
     realloc_strings (ns);
 }
index 1db9f6e563495592447d6784f5ed9c6773b2cf84..2a15ab021fee18f0b4bd675f16ac311394726070 100644 (file)
@@ -1,3 +1,8 @@
+2016-07-28  Paul Thomas  <pault@gcc.gnu.org>
+
+       PR fortran/71883
+       * gfortran.dg/pr71883.f90 : New test.
+
 2016-07-28  Yuri Rumyantsev  <ysrumyan@gmail.com>
 
        PR tree-optimization/71734
@@ -43,7 +48,7 @@
 
 2016-07-27  Senthil Kumar Selvaraj  <senthil_kumar.selvaraj@atmel.com>
 
-       * gcc.dg/torture/pr69352.c: Use  __INTPTR_TYPE__ instead of 
+       * gcc.dg/torture/pr69352.c: Use  __INTPTR_TYPE__ instead of
        including stdint.h.
        * gcc.dg/torture/pr71866.c: Use __UINTPTR_TYPE__ isntead of
        including stdint.h.
 
 2016-07-19  Senthil Kumar Selvaraj  <senthil_kumar.selvaraj@atmel.com>
 
-       * gcc.dg/params/blocksort-part.c: Conditionally define Int32 
+       * gcc.dg/params/blocksort-part.c: Conditionally define Int32
        and UInt32 based on __SIZEOF_INT__.
 
 2016-07-19  Richard Biener  <rguenther@suse.de>
diff --git a/gcc/testsuite/gfortran.dg/pr71883.f90 b/gcc/testsuite/gfortran.dg/pr71883.f90
new file mode 100644 (file)
index 0000000..23ed6a6
--- /dev/null
@@ -0,0 +1,38 @@
+! { dg-do compile }
+!
+! Test the fix for pr71883, in which an ICE would follow the error.
+!
+! Contributed by Gerhard Steinmetz  <gerhard.steinmetz.fortran@t-online.de>
+!
+program p
+   character(3), allocatable :: z(:,:)
+   z(1:2,1:2) = 'abc'
+   z(2,1) = z(12) ! { dg-error "Rank mismatch in array reference" }
+   z(21) = z(1,2) ! { dg-error "Rank mismatch in array reference" }
+contains
+   subroutine a
+      character(3), allocatable :: z(:,:)
+      z(1:2,1:2) = 'abc'
+      z(2,1) = z(-1) ! { dg-error "Rank mismatch in array reference" }
+      z(2,1) = z(99) ! { dg-error "Rank mismatch in array reference" }
+      z(2,1) = z(huge(0)) ! { dg-error "Rank mismatch in array reference" }
+      z(2,1) = z(-huge(0)) ! { dg-error "Rank mismatch in array reference" }
+      z(-1) = z(2,1) ! { dg-error "Rank mismatch in array reference" }
+      z(99) = z(2,1) ! { dg-error "Rank mismatch in array reference" }
+      z(huge(0)) = z(2,1) ! { dg-error "Rank mismatch in array reference" }
+      z(-huge(0)) = z(2,1) ! { dg-error "Rank mismatch in array reference" }
+  end subroutine
+
+   subroutine b
+      character(:), allocatable :: z(:,:)
+      z(1:2,1:2) = 'abc'
+      z(2,1) = z(-1) ! { dg-error "Rank mismatch in array reference" }
+      z(2,1) = z(99) ! { dg-error "Rank mismatch in array reference" }
+      z(2,1) = z(huge(0)) ! { dg-error "Rank mismatch in array reference" }
+      z(2,1) = z(-huge(0)) ! { dg-error "Rank mismatch in array reference" }
+      z(-1) = z(2,1) ! { dg-error "Rank mismatch in array reference" }
+      z(99) = z(2,1) ! { dg-error "Rank mismatch in array reference" }
+     z(huge(0)) = z(2,1) ! { dg-error "Rank mismatch in array reference" }
+      z(-huge(0)) = z(2,1) ! { dg-error "Rank mismatch in array reference" }
+   end subroutine
+end