diff mbox series

[Fortran,1/1] Tweak locations around CAF simplify

Message ID 20211027212941.309870-2-rep.dot.nop@gmail.com
State New
Headers
Series Correct CAF locations in simplify |

Commit Message

Bernhard Reutner-Fischer Oct. 27, 2021, 9:29 p.m. UTC 
  From: Bernhard Reutner-Fischer <aldot@gcc.gnu.org>

addresses: FIXME: gfc_current_locus is wrong
by using the locus of the current intrinsic.
Regtests clean, ok for trunk?

gcc/fortran/ChangeLog:

2018-09-20  Bernhard Reutner-Fischer  <aldot@gcc.gnu.org>

	* simplify.c (gfc_simplify_failed_or_stopped_images): Use
	current intrinsic where locus.
	(gfc_simplify_get_team): Likewise.
	(gfc_simplify_num_images): Likewise.
	(gfc_simplify_image_status): Likewise.
	(gfc_simplify_this_image): Likewise.
---
 gcc/fortran/simplify.c | 28 +++++++++++++++-------------
 1 file changed, 15 insertions(+), 13 deletions(-)

Comments

Mikael Morin Nov. 5, 2021, 7:53 p.m. UTC | #1 
Le 27/10/2021 à 23:29, Bernhard Reutner-Fischer via Fortran a écrit :
> From: Bernhard Reutner-Fischer <aldot@gcc.gnu.org>
> 
> addresses: FIXME: gfc_current_locus is wrong
> by using the locus of the current intrinsic.
> Regtests clean, ok for trunk?
> 
Hello,

I’m not convinced that replacing a global variable by an other really 
fixes things.
gfc_current_intrinsic_where is only valid if the simplification 
functions are called from gfc_intrinsic_func_interface.
The fatal errors hardly need a location anyway; as for the rest, well...

A proper fix would add a location argument to gfc_simplify_f’s union 
fields (and maybe gfc_check_f’s as well), and the associated 
simplification functions.
As the impact would be somewhat massive, maybe add new distinct union 
fields with location arguments and a procedure (a switch on the 
intrinsic id basically) to decide which field to use.
Does it sound good to you?

Mikael
diff mbox series

Patch

diff --git a/gcc/fortran/simplify.c b/gcc/fortran/simplify.c
index d675f2c3aef..46e88bb2bf1 100644
--- a/gcc/fortran/simplify.c
+++ b/gcc/fortran/simplify.c
@@ -2985,8 +2985,9 @@  gfc_simplify_failed_or_stopped_images (gfc_expr *team ATTRIBUTE_UNUSED,
 {
   if (flag_coarray == GFC_FCOARRAY_NONE)
     {
-      gfc_current_locus = *gfc_current_intrinsic_where;
-      gfc_fatal_error ("Coarrays disabled at %C, use %<-fcoarray=%> to enable");
+      gfc_fatal_error ("Coarrays disabled at %L, use %<-fcoarray=%> to enable",
+	  gfc_current_intrinsic_where);
+
       return &gfc_bad_expr;
     }
 
@@ -2999,7 +3000,8 @@  gfc_simplify_failed_or_stopped_images (gfc_expr *team ATTRIBUTE_UNUSED,
       else
 	actual_kind = gfc_default_integer_kind;
 
-      result = gfc_get_array_expr (BT_INTEGER, actual_kind, &gfc_current_locus);
+      result = gfc_get_array_expr (BT_INTEGER, actual_kind,
+	  gfc_current_intrinsic_where);
       result->rank = 1;
       return result;
     }
@@ -3015,15 +3017,16 @@  gfc_simplify_get_team (gfc_expr *level ATTRIBUTE_UNUSED)
 {
   if (flag_coarray == GFC_FCOARRAY_NONE)
     {
-      gfc_current_locus = *gfc_current_intrinsic_where;
-      gfc_fatal_error ("Coarrays disabled at %C, use %<-fcoarray=%> to enable");
+      gfc_fatal_error ("Coarrays disabled at %L, use %<-fcoarray=%> to enable",
+	  gfc_current_intrinsic_where);
       return &gfc_bad_expr;
     }
 
   if (flag_coarray == GFC_FCOARRAY_SINGLE)
     {
       gfc_expr *result;
-      result = gfc_get_array_expr (BT_INTEGER, gfc_default_integer_kind, &gfc_current_locus);
+      result = gfc_get_array_expr (BT_INTEGER, gfc_default_integer_kind,
+	  gfc_current_intrinsic_where);
       result->rank = 0;
       return result;
     }
@@ -6340,7 +6343,8 @@  gfc_simplify_num_images (gfc_expr *distance ATTRIBUTE_UNUSED, gfc_expr *failed)
 
   if (flag_coarray == GFC_FCOARRAY_NONE)
     {
-      gfc_fatal_error ("Coarrays disabled at %C, use %<-fcoarray=%> to enable");
+      gfc_fatal_error ("Coarrays disabled at %L, use %<-fcoarray=%> to enable",
+	  gfc_current_intrinsic_where);
       return &gfc_bad_expr;
     }
 
@@ -6350,9 +6354,8 @@  gfc_simplify_num_images (gfc_expr *distance ATTRIBUTE_UNUSED, gfc_expr *failed)
   if (failed && failed->expr_type != EXPR_CONSTANT)
     return NULL;
 
-  /* FIXME: gfc_current_locus is wrong.  */
   result = gfc_get_constant_expr (BT_INTEGER, gfc_default_integer_kind,
-				  &gfc_current_locus);
+				  gfc_current_intrinsic_where);
 
   if (failed && failed->value.logical != 0)
     mpz_set_si (result->value.integer, 0);
@@ -8345,8 +8348,8 @@  gfc_simplify_image_status (gfc_expr *image, gfc_expr *team ATTRIBUTE_UNUSED)
 {
   if (flag_coarray == GFC_FCOARRAY_NONE)
     {
-      gfc_current_locus = *gfc_current_intrinsic_where;
-      gfc_fatal_error ("Coarrays disabled at %C, use %<-fcoarray=%> to enable");
+      gfc_fatal_error ("Coarrays disabled at %L, use %<-fcoarray=%> to enable",
+	  gfc_current_intrinsic_where);
       return &gfc_bad_expr;
     }
 
@@ -8383,9 +8386,8 @@  gfc_simplify_this_image (gfc_expr *coarray, gfc_expr *dim,
   if (coarray == NULL || !gfc_is_coarray (coarray))
     {
       gfc_expr *result;
-      /* FIXME: gfc_current_locus is wrong.  */
       result = gfc_get_constant_expr (BT_INTEGER, gfc_default_integer_kind,
-				      &gfc_current_locus);
+				      gfc_current_intrinsic_where);
       mpz_set_si (result->value.integer, 1);
       return result;
     }