Partial Failed Images patch

Co-Authored-By: Alessandro Fanfarillo <fanfarillo.gcc@gmail.com>
Co-Authored-By: Soren Rasmussen <s.c.rasmussen@gmail.com>

From-SVN: r257105

1 files changed, 48 insertions, 22 deletions

diff --git a/gcc/fortran/iresolve.c b/gcc/fortran/iresolve.c
index 9a4e199d01e..21344321709 100644
--- a/gcc/fortran/iresolve.c
+++ b/gcc/fortran/iresolve.c
@@ -36,10 +36,10 @@ along with GCC; see the file COPYING3.  If not see
 #include "constructor.h"
 #include "arith.h"
 
-/* Given printf-like arguments, return a stable version of the result string. 
+/* Given printf-like arguments, return a stable version of the result string.
 
    We already have a working, optimized string hashing table in the form of
-   the identifier table.  Reusing this table is likely not to be wasted, 
+   the identifier table.  Reusing this table is likely not to be wasted,
    since if the function name makes it to the gimple output of the frontend,
    we'll have to create the identifier anyway.  */
 
@@ -316,7 +316,7 @@ gfc_resolve_aint (gfc_expr *f, gfc_expr *a, gfc_expr *kind)
 {
   gfc_typespec ts;
   gfc_clear_ts (&ts);
-  
+
   f->ts.type = a->ts.type;
   f->ts.kind = (kind == NULL) ? a->ts.kind : mpz_get_si (kind->value.integer);
 
@@ -363,7 +363,7 @@ gfc_resolve_anint (gfc_expr *f, gfc_expr *a, gfc_expr *kind)
 {
   gfc_typespec ts;
   gfc_clear_ts (&ts);
-  
+
   f->ts.type = a->ts.type;
   f->ts.kind = (kind == NULL) ? a->ts.kind : mpz_get_si (kind->value.integer);
 
@@ -458,7 +458,7 @@ gfc_resolve_besn (gfc_expr *f, gfc_expr *n, gfc_expr *x)
 {
   gfc_typespec ts;
   gfc_clear_ts (&ts);
-  
+
   f->ts = x->ts;
   if (n->ts.kind != gfc_c_int_kind)
     {
@@ -475,7 +475,7 @@ gfc_resolve_bessel_n2 (gfc_expr *f, gfc_expr *n1, gfc_expr *n2, gfc_expr *x)
 {
   gfc_typespec ts;
   gfc_clear_ts (&ts);
-  
+
   f->ts = x->ts;
   f->rank = 1;
   if (n1->expr_type == EXPR_CONSTANT && n2->expr_type == EXPR_CONSTANT)
@@ -811,7 +811,7 @@ gfc_resolve_cshift (gfc_expr *f, gfc_expr *array, gfc_expr *shift,
   m = gfc_default_integer_kind;
   if (dim != NULL)
     m = m < dim->ts.kind ? dim->ts.kind : m;
-  
+
   /* Convert shift to at least m, so we don't need
       kind=1 and kind=2 versions of the library functions.  */
   if (shift->ts.kind < m)
@@ -822,7 +822,7 @@ gfc_resolve_cshift (gfc_expr *f, gfc_expr *array, gfc_expr *shift,
       ts.kind = m;
       gfc_convert_type_warn (shift, &ts, 2, 0);
     }
- 
+
   if (dim != NULL)
     {
       if (dim->expr_type != EXPR_CONSTANT && dim->symtree != NULL
@@ -861,7 +861,7 @@ gfc_resolve_ctime (gfc_expr *f, gfc_expr *time)
 {
   gfc_typespec ts;
   gfc_clear_ts (&ts);
-  
+
   f->ts.type = BT_CHARACTER;
   f->ts.kind = gfc_default_character_kind;
 
@@ -976,7 +976,7 @@ gfc_resolve_eoshift (gfc_expr *f, gfc_expr *array, gfc_expr *shift,
   m = gfc_default_integer_kind;
   if (dim != NULL)
     m = m < dim->ts.kind ? dim->ts.kind : m;
-  
+
   /* Convert shift to at least m, so we don't need
       kind=1 and kind=2 versions of the library functions.  */
   if (shift->ts.kind < m)
@@ -987,7 +987,7 @@ gfc_resolve_eoshift (gfc_expr *f, gfc_expr *array, gfc_expr *shift,
       ts.kind = m;
       gfc_convert_type_warn (shift, &ts, 2, 0);
     }
- 
+
   if (dim != NULL)
     {
       if (dim->expr_type != EXPR_CONSTANT && dim->symtree != NULL
@@ -1225,7 +1225,7 @@ void
 gfc_resolve_iand (gfc_expr *f, gfc_expr *i, gfc_expr *j)
 {
   /* If the kind of i and j are different, then g77 cross-promoted the
-     kinds to the largest value.  The Fortran 95 standard requires the 
+     kinds to the largest value.  The Fortran 95 standard requires the
      kinds to match.  */
   if (i->ts.kind != j->ts.kind)
     {
@@ -1316,7 +1316,7 @@ void
 gfc_resolve_ieor (gfc_expr *f, gfc_expr *i, gfc_expr *j)
 {
   /* If the kind of i and j are different, then g77 cross-promoted the
-     kinds to the largest value.  The Fortran 95 standard requires the 
+     kinds to the largest value.  The Fortran 95 standard requires the
      kinds to match.  */
   if (i->ts.kind != j->ts.kind)
     {
@@ -1335,7 +1335,7 @@ void
 gfc_resolve_ior (gfc_expr *f, gfc_expr *i, gfc_expr *j)
 {
   /* If the kind of i and j are different, then g77 cross-promoted the
-     kinds to the largest value.  The Fortran 95 standard requires the 
+     kinds to the largest value.  The Fortran 95 standard requires the
      kinds to match.  */
   if (i->ts.kind != j->ts.kind)
     {
@@ -1435,7 +1435,7 @@ gfc_resolve_isatty (gfc_expr *f, gfc_expr *u)
 {
   gfc_typespec ts;
   gfc_clear_ts (&ts);
-  
+
   f->ts.type = BT_LOGICAL;
   f->ts.kind = gfc_default_integer_kind;
   if (u->ts.kind != gfc_c_int_kind)
@@ -1642,7 +1642,7 @@ gfc_resolve_matmul (gfc_expr *f, gfc_expr *a, gfc_expr *b)
 	  mpz_init_set (f->shape[0], b->shape[1]);
 	}
     }
-  else 
+  else
     {
       /* b->rank == 1 and a->rank == 2 here, all other cases have
 	 been caught in check.c.   */
@@ -2961,6 +2961,19 @@ gfc_resolve_image_status (gfc_expr *f, gfc_expr *image ATTRIBUTE_UNUSED,
 }
 
 
+/* Resolve get_team ().  */
+
+void
+gfc_resolve_get_team (gfc_expr *f, gfc_expr *level ATTRIBUTE_UNUSED)
+{
+  static char get_team[] = "_gfortran_caf_get_team";
+  f->rank = 0;
+  f->ts.type = BT_INTEGER;
+  f->ts.kind = gfc_default_integer_kind;
+  f->value.function.name = get_team;
+}
+
+
 /* Resolve image_index (...).  */
 
 void
@@ -2991,6 +3004,19 @@ gfc_resolve_stopped_images (gfc_expr *f, gfc_expr *team ATTRIBUTE_UNUSED,
 }
 
 
+/* Resolve team_number (team).  */
+
+void
+gfc_resolve_team_number (gfc_expr *f, gfc_expr *team ATTRIBUTE_UNUSED)
+{
+  static char team_number[] = "_gfortran_caf_team_number";
+  f->rank = 0;
+  f->ts.type = BT_INTEGER;
+  f->ts.kind = gfc_default_integer_kind;
+  f->value.function.name = team_number;
+}
+
+
 void
 gfc_resolve_this_image (gfc_expr *f, gfc_expr *array, gfc_expr *dim,
 			gfc_expr *distance ATTRIBUTE_UNUSED)
@@ -3180,7 +3206,7 @@ gfc_resolve_ttynam (gfc_expr *f, gfc_expr *unit)
 {
   gfc_typespec ts;
   gfc_clear_ts (&ts);
-  
+
   f->ts.type = BT_CHARACTER;
   f->ts.kind = gfc_default_character_kind;
 
@@ -3399,7 +3425,7 @@ gfc_resolve_random_number (gfc_code *c)
     name = gfc_get_string (PREFIX ("random_r%d"), kind);
   else
     name = gfc_get_string (PREFIX ("arandom_r%d"), kind);
-  
+
   c->resolved_sym = gfc_get_intrinsic_sub_symbol (name);
 }
 
@@ -3444,7 +3470,7 @@ gfc_resolve_kill_sub (gfc_code *c)
   name = gfc_get_string (PREFIX ("kill_i%d_sub"), kind);
   c->resolved_sym = gfc_get_intrinsic_sub_symbol (name);
 }
-    
+
 
 void
 gfc_resolve_link_sub (gfc_code *c)
@@ -3777,7 +3803,7 @@ gfc_resolve_ctime_sub (gfc_code *c)
 {
   gfc_typespec ts;
   gfc_clear_ts (&ts);
-  
+
   /* ctime TIME argument is a INTEGER(KIND=8), says the doc */
   if (c->ext.actual->expr->ts.kind != 8)
     {
@@ -3961,7 +3987,7 @@ gfc_resolve_fput_sub (gfc_code *c)
 }
 
 
-void 
+void
 gfc_resolve_fseek_sub (gfc_code *c)
 {
   gfc_expr *unit;
@@ -4035,7 +4061,7 @@ gfc_resolve_ttynam_sub (gfc_code *c)
 {
   gfc_typespec ts;
   gfc_clear_ts (&ts);
-  
+
   if (c->ext.actual->expr->ts.kind != gfc_c_int_kind)
     {
       ts.type = BT_INTEGER;