trans.c (tree_transform, emit_check): Adjust calls to build_call_raise, passing…

trans.c (tree_transform, emit_check): Adjust calls to build_call_raise, passing the now expected GNAT_NODE argument.

2005-12-05  Olivier Hainque  <hainque@adacore.com>
	    Eric Botcazou  <ebotcazou@adacore.com>

	* trans.c (tree_transform, emit_check): Adjust calls to
	build_call_raise, passing the now expected GNAT_NODE argument.

	* gigi.h (build_call_raise): Add a GNAT_NODE argument to convey better
	source line information than what the current global locus indicates
	when appropriate.

	* utils2.c (build_simple_component_ref): Return 0 if the offset of the
	field has overflowed.
	(build_call_raise): Add a GNAT_NODE argument to convey better source
	line information than what the current global locus indicates when
	appropriate.
	(build_component_ref): Adjust call to build_call_raise.

From-SVN: r108290

gcc/ada/gigi.h

@@ -710,8 +710,12 @@ extern tree build_call_2_expr (tree fundecl, tree arg1, tree arg2);
 extern tree build_call_0_expr (tree fundecl);
 
 /* Call a function that raises an exception and pass the line number and file
-   name, if requested.  MSG says which exception function to call.  */
-extern tree build_call_raise (int msg);
+   name, if requested.  MSG says which exception function to call.
+
+   GNAT_NODE is the gnat node conveying the source location for which the
+   error should be signaled, or Empty in which case the error is signaled on
+   the current ref_file_name/input_line.  */
+extern tree build_call_raise (int msg, Node_Id gnat_node);
 
 /* Return a CONSTRUCTOR of TYPE whose list is LIST.  This is not the
    same as build_constructor in the language-independent tree.c.  */

gcc/ada/trans.c

@@ -1546,14 +1546,18 @@ call_to_gnu (Node_Id gnat_node, tree *gnu_result_type_p, tree gnu_target)
 	   gnat_actual = Next_Actual (gnat_actual))
 	add_stmt (gnat_to_gnu (gnat_actual));
 
-      if (Nkind (gnat_node) == N_Function_Call && !gnu_target)
-	{
-	  *gnu_result_type_p = TREE_TYPE (gnu_subprog_type);
-	  return build1 (NULL_EXPR, *gnu_result_type_p,
-			 build_call_raise (PE_Stubbed_Subprogram_Called));
-	}
-      else
-	return build_call_raise (PE_Stubbed_Subprogram_Called);
+      {
+	tree call_expr
+	  = build_call_raise (PE_Stubbed_Subprogram_Called, gnat_node);
+
+	if (Nkind (gnat_node) == N_Function_Call && !gnu_target)
+	  {
+	    *gnu_result_type_p = TREE_TYPE (gnu_subprog_type);
+	    return build1 (NULL_EXPR, *gnu_result_type_p, call_expr);
+	  }
+	else
+	  return call_expr;
+      }
     }
 
   /* If we are calling by supplying a pointer to a target, set up that
@@ -2515,7 +2519,7 @@ gnat_to_gnu (Node_Id gnat_node)
       && Nkind (gnat_node) != N_Identifier
       && !Compile_Time_Known_Value (gnat_node))
     return build1 (NULL_EXPR, get_unpadded_type (Etype (gnat_node)),
-		   build_call_raise (CE_Range_Check_Failed));
+		   build_call_raise (CE_Range_Check_Failed, gnat_node));
 
   /* If this is a Statement and we are at top level, it must be part of the
      elaboration procedure, so mark us as being in that procedure and push our
@@ -3463,7 +3467,7 @@ gnat_to_gnu (Node_Id gnat_node)
 	 Storage_Error: execution shouldn't have gotten here anyway.  */
       if (TREE_CODE (TYPE_SIZE_UNIT (TREE_TYPE (gnu_lhs))) == INTEGER_CST
 	   && TREE_OVERFLOW (TYPE_SIZE_UNIT (TREE_TYPE (gnu_lhs))))
-	gnu_result = build_call_raise (SE_Object_Too_Large);
+	gnu_result = build_call_raise (SE_Object_Too_Large, gnat_node);
       else if (Nkind (Expression (gnat_node)) == N_Function_Call
 	       && !Do_Range_Check (Expression (gnat_node)))
 	gnu_result = call_to_gnu (Expression (gnat_node),
@@ -4037,7 +4041,8 @@ gnat_to_gnu (Node_Id gnat_node)
 	}
 
       gnu_result_type = get_unpadded_type (Etype (gnat_node));
-      gnu_result = build_call_raise (UI_To_Int (Reason (gnat_node)));
+      gnu_result
+	= build_call_raise (UI_To_Int (Reason (gnat_node)), gnat_node);
 
       /* If the type is VOID, this is a statement, so we need to
 	 generate the code for the call.  Handle a Condition, if there
@@ -4148,7 +4153,7 @@ gnat_to_gnu (Node_Id gnat_node)
 
       gnu_result
 	= build1 (NULL_EXPR, gnu_result_type,
-		  build_call_raise (CE_Overflow_Check_Failed));
+		  build_call_raise (CE_Overflow_Check_Failed, gnat_node));
     }
 
   /* If our result has side-effects and is of an unconstrained type,
@@ -5207,7 +5212,7 @@ emit_check (tree gnu_cond, tree gnu_expr, int reason)
   tree gnu_call;
   tree gnu_result;
 
-  gnu_call = build_call_raise (reason);
+  gnu_call = build_call_raise (reason, Empty);
 
   /* Use an outer COMPOUND_EXPR to make sure that GNU_EXPR will get evaluated
      in front of the comparison in case it ends up being a SAVE_EXPR.  Put the

gcc/ada/utils2.c

@@ -37,6 +37,7 @@
 #include "types.h"
 #include "atree.h"
 #include "stringt.h"
+#include "namet.h"
 #include "uintp.h"
 #include "fe.h"
 #include "elists.h"
@@ -854,7 +855,8 @@ build_binary_op (enum tree_code op_code, tree result_type,
 	       && TREE_CODE (right_operand) == CONSTRUCTOR
 	       && integer_zerop (VEC_index (constructor_elt,
 					    CONSTRUCTOR_ELTS (right_operand),
-					    0)->value))
+					    0)
+				 ->value))
 	{
 	  right_operand = build_component_ref (left_operand, NULL_TREE,
 					       TYPE_FIELDS (left_base_type),
@@ -1107,13 +1109,13 @@ build_unary_op (enum tree_code op_code, tree result_type, tree operand)
 	     a pointer to our type.  */
 	  if (TREE_CODE (type) == RECORD_TYPE && TYPE_IS_PADDING_P (type))
 	    {
-	      result = VEC_index (constructor_elt,
-				  CONSTRUCTOR_ELTS (operand),
-				  0)->value;
-	      result
-		= build_unary_op (ADDR_EXPR, NULL_TREE, result);
+	      result = (VEC_index (constructor_elt,
+				   CONSTRUCTOR_ELTS (operand),
+				   0)
+			->value);
+
 	      result = convert (build_pointer_type (TREE_TYPE (operand)),
-				result);
+				build_unary_op (ADDR_EXPR, NULL_TREE, result));
 	      break;
 	    }
 
@@ -1443,17 +1445,34 @@ build_call_0_expr (tree fundecl)
 }
 
 /* Call a function that raises an exception and pass the line number and file
-   name, if requested.  MSG says which exception function to call.  */
+   name, if requested.  MSG says which exception function to call.
+
+   GNAT_NODE is the gnat node conveying the source location for which the
+   error should be signaled, or Empty in which case the error is signaled on
+   the current ref_file_name/input_line.  */
 
 tree
-build_call_raise (int msg)
+build_call_raise (int msg, Node_Id gnat_node)
 {
   tree fndecl = gnat_raise_decls[msg];
+
   const char *str
-    = (Debug_Flag_NN || Exception_Locations_Suppressed) ? "" : ref_filename;
+    = (Debug_Flag_NN || Exception_Locations_Suppressed)
+      ? ""
+      : (gnat_node != Empty)
+        ? IDENTIFIER_POINTER
+          (get_identifier (Get_Name_String
+			   (Debug_Source_Name
+			    (Get_Source_File_Index (Sloc (gnat_node))))))
+        : ref_filename;
+
   int len = strlen (str) + 1;
   tree filename = build_string (len, str);
 
+  int line_number
+    = (gnat_node != Empty)
+      ? Get_Logical_Line_Number (Sloc(gnat_node)) : input_line;
+
   TREE_TYPE (filename)
     = build_array_type (char_type_node,
 			build_index_type (build_int_cst (NULL_TREE, len)));
@@ -1462,7 +1481,7 @@ build_call_raise (int msg)
     build_call_2_expr (fndecl,
 		       build1 (ADDR_EXPR, build_pointer_type (char_type_node),
 			       filename),
-		       build_int_cst (NULL_TREE, input_line));
+		       build_int_cst (NULL_TREE, line_number));
 }
 
 /* qsort comparer for the bit positions of two constructor elements
@@ -1631,6 +1650,14 @@ build_simple_component_ref (tree record_variable, tree component,
   if (!field)
     return NULL_TREE;
 
+  /* If the field's offset has overflowed, do not attempt to access it
+     as doing so may trigger sanity checks deeper in the back-end.
+     Note that we don't need to warn since this will be done on trying
+     to declare the object.  */
+  if (TREE_CODE (DECL_FIELD_OFFSET (field)) == INTEGER_CST
+      && TREE_CONSTANT_OVERFLOW (DECL_FIELD_OFFSET (field)))
+    return NULL_TREE;
+
   /* It would be nice to call "fold" here, but that can lose a type
      we need to tag a PLACEHOLDER_EXPR with, so we can't do it.  */
   ref = build3 (COMPONENT_REF, TREE_TYPE (field), record_variable, field,
@@ -1663,7 +1690,7 @@ build_component_ref (tree record_variable, tree component,
      abort.  */
   gcc_assert (field);
   return build1 (NULL_EXPR, TREE_TYPE (field),
-		 build_call_raise (CE_Discriminant_Check_Failed));
+		 build_call_raise (CE_Discriminant_Check_Failed, Empty));
 }
 
 /* Build a GCC tree to call an allocation or deallocation function.