exp_ch2.adb (Expand_Current_Value): Make an appropriate character literal if the entity is of a character type.

* exp_ch2.adb (Expand_Current_Value): Make an appropriate character
	literal if the entity is of a character type.
	* gcc-interface/lang.opt (fsigned-char): New option.
	* gcc-interface/misc.c (gnat_handle_option): Accept it.
	(gnat_init): Adjust comment.
	* gcc-interface/gigi.h (finish_character_type): New prototype.
	(maybe_character_type): New inline function.
	(maybe_character_value): Likewise.
	* gcc-interface/decl.c (gnat_to_gnu_entity) <E_Enumeration_Type>: For
	a character of CHAR_TYPE_SIZE, make a signed type if flag_signed_char.
	Set TYPE_ARTIFICIAL early and call finish_character_type on the type.
	<E_Enumeration_Subtype>: For a subtype of character with RM_Size and
	Esize equal to CHAR_TYPE_SIZE, make a signed type if flag_signed_char.
	Copy TYPE_STRING_FLAG from type to subtype.
	<E_Array_Type>: Deal with character index types.
	<E_Array_Subtype>: Likewise.
	* gcc-interface/trans.c (gigi): Replace unsigned_char_type_node with
	char_type_node throughout.
	(build_raise_check): Likewise.
	(get_type_length): Deal with character types.
	(Attribute_to_gnu) <Attr_Pos>: Likewise.  Remove obsolete range check
	code.  Minor tweak.
	<Attr_Pred>: Likewise.
	(Loop_Statement_to_gnu): Likewise.
	(Raise_Error_to_gnu): Likewise.
	<N_Indexed_Component>: Deal with character index types.  Remove
	obsolete code.
	<N_Slice>: Likewise.
	<N_Type_Conversion>: Deal with character types.  Minor tweak.
	<N_Unchecked_Type_Conversion>: Likewise.
	<N_In>: Likewise.
	<N_Op_Eq>: Likewise.
	(emit_index_check): Delete.
	* gcc-interface/utils.c (finish_character_type): New function.
	(gnat_signed_or_unsigned_type_for): Deal with built-in character types.
	* gcc-interface/utils2.c (expand_sloc): Replace unsigned_char_type_node
	with char_type_node.
	(build_call_raise): Likewise.
	(build_call_raise_column): Likewise.
	(build_call_raise_range): Likewise.

From-SVN: r232604

gcc/ada/ChangeLog

@@ -1,3 +1,46 @@
+2016-01-20  Eric Botcazou  <ebotcazou@adacore.com>
+
+	* exp_ch2.adb (Expand_Current_Value): Make an appropriate character
+	literal if the entity is of a character type.
+	* gcc-interface/lang.opt (fsigned-char): New option.
+	* gcc-interface/misc.c (gnat_handle_option): Accept it.
+	(gnat_init): Adjust comment.
+	* gcc-interface/gigi.h (finish_character_type): New prototype.
+	(maybe_character_type): New inline function.
+	(maybe_character_value): Likewise.
+	* gcc-interface/decl.c (gnat_to_gnu_entity) <E_Enumeration_Type>: For
+	a character of CHAR_TYPE_SIZE, make a signed type if flag_signed_char.
+	Set TYPE_ARTIFICIAL early and call finish_character_type on the type.
+	<E_Enumeration_Subtype>: For a subtype of character with RM_Size and
+	Esize equal to CHAR_TYPE_SIZE, make a signed type if flag_signed_char.
+	Copy TYPE_STRING_FLAG from type to subtype.
+	<E_Array_Type>: Deal with character index types.
+	<E_Array_Subtype>: Likewise.
+	* gcc-interface/trans.c (gigi): Replace unsigned_char_type_node with
+	char_type_node throughout.
+	(build_raise_check): Likewise.
+	(get_type_length): Deal with character types.
+	(Attribute_to_gnu) <Attr_Pos>: Likewise.  Remove obsolete range check
+	code.  Minor tweak.
+	<Attr_Pred>: Likewise.
+	(Loop_Statement_to_gnu): Likewise.
+	(Raise_Error_to_gnu): Likewise.
+	<N_Indexed_Component>: Deal with character index types.  Remove
+	obsolete code.
+	<N_Slice>: Likewise.
+	<N_Type_Conversion>: Deal with character types.  Minor tweak.
+	<N_Unchecked_Type_Conversion>: Likewise.
+	<N_In>: Likewise.
+	<N_Op_Eq>: Likewise.
+	(emit_index_check): Delete.
+	* gcc-interface/utils.c (finish_character_type): New function.
+	(gnat_signed_or_unsigned_type_for): Deal with built-in character types.
+	* gcc-interface/utils2.c (expand_sloc): Replace unsigned_char_type_node
+	with char_type_node.
+	(build_call_raise): Likewise.
+	(build_call_raise_column): Likewise.
+	(build_call_raise_range): Likewise.
+
 2016-01-18  Eric Botcazou  <ebotcazou@adacore.com>
 
 	* gcc-interface/gigi.h (build_call_raise_column): Adjust prototype.

gcc/ada/exp_ch2.adb

@@ -6,7 +6,7 @@
 --                                                                          --
 --                                 B o d y                                  --
 --                                                                          --
---          Copyright (C) 1992-2015, Free Software Foundation, Inc.         --
+--          Copyright (C) 1992-2016, Free Software Foundation, Inc.         --
 --                                                                          --
 -- GNAT is free software;  you can  redistribute it  and/or modify it under --
 -- terms of the  GNU General Public License as published  by the Free Soft- --
@@ -193,7 +193,16 @@ package body Exp_Ch2 is
               Unchecked_Convert_To (T,
                 New_Occurrence_Of (Entity (Val), Loc)));
 
-         --  If constant is of an integer type, just make an appropriately
+         --  If constant is of a character type, just make an appropriate
+         --  character literal, which will get the proper type.
+
+         elsif Is_Character_Type (T) then
+            Rewrite (N,
+              Make_Character_Literal (Loc,
+                Chars => Chars (Val),
+                Char_Literal_Value => Expr_Rep_Value (Val)));
+
+         --  If constant is of an integer type, just make an appropriate
          --  integer literal, which will get the proper type.
 
          elsif Is_Integer_Type (T) then

gcc/ada/gcc-interface/decl.c

@@ -1560,16 +1560,24 @@ gnat_to_gnu_entity (Entity_Id gnat_entity, tree gnu_expr, int definition)
     case E_Enumeration_Type:
       /* A special case: for the types Character and Wide_Character in
 	 Standard, we do not list all the literals.  So if the literals
-	 are not specified, make this an unsigned integer type.  */
+	 are not specified, make this an integer type.  */
       if (No (First_Literal (gnat_entity)))
 	{
-	  gnu_type = make_unsigned_type (esize);
+	  if (esize == CHAR_TYPE_SIZE && flag_signed_char)
+	    gnu_type = make_signed_type (CHAR_TYPE_SIZE);
+	  else
+	    gnu_type = make_unsigned_type (esize);
 	  TYPE_NAME (gnu_type) = gnu_entity_name;
 
 	  /* Set TYPE_STRING_FLAG for Character and Wide_Character types.
 	     This is needed by the DWARF-2 back-end to distinguish between
 	     unsigned integer types and character types.  */
 	  TYPE_STRING_FLAG (gnu_type) = 1;
+
+	  /* This flag is needed by the call just below.  */
+	  TYPE_ARTIFICIAL (gnu_type) = artificial_p;
+
+	  finish_character_type (gnu_type);
 	}
       else
 	{
@@ -1765,12 +1773,19 @@ gnat_to_gnu_entity (Entity_Id gnat_entity, tree gnu_expr, int definition)
 	  && Is_Bit_Packed_Array (Original_Array_Type (gnat_entity)))
 	esize = UI_To_Int (RM_Size (gnat_entity));
 
-      /* This should be an unsigned type if the base type is unsigned or
+      /* First subtypes of Character are treated as Character; otherwise
+	 this should be an unsigned type if the base type is unsigned or
 	 if the lower bound is constant and non-negative or if the type
 	 is biased.  */
-      if (Is_Unsigned_Type (Etype (gnat_entity))
+      if (kind == E_Enumeration_Subtype
-	  || Is_Unsigned_Type (gnat_entity)
+	  && No (First_Literal (Etype (gnat_entity)))
-	  || Has_Biased_Representation (gnat_entity))
+	  && Esize (gnat_entity) == RM_Size (gnat_entity)
+	  && esize == CHAR_TYPE_SIZE
+	  && flag_signed_char)
+	gnu_type = make_signed_type (CHAR_TYPE_SIZE);
+      else if (Is_Unsigned_Type (Etype (gnat_entity))
+	       || Is_Unsigned_Type (gnat_entity)
+	       || Has_Biased_Representation (gnat_entity))
 	gnu_type = make_unsigned_type (esize);
       else
 	gnu_type = make_signed_type (esize);
@@ -1789,6 +1804,9 @@ gnat_to_gnu_entity (Entity_Id gnat_entity, tree gnu_expr, int definition)
       TYPE_BIASED_REPRESENTATION_P (gnu_type)
 	= Has_Biased_Representation (gnat_entity);
 
+      /* Set TYPE_STRING_FLAG for Character and Wide_Character subtypes.  */
+      TYPE_STRING_FLAG (gnu_type) = TYPE_STRING_FLAG (TREE_TYPE (gnu_type));
+
       /* Inherit our alias set from what we're a subtype of.  Subtypes
 	 are not different types and a pointer can designate any instance
 	 within a subtype hierarchy.  */
@@ -2114,7 +2132,8 @@ gnat_to_gnu_entity (Entity_Id gnat_entity, tree gnu_expr, int definition)
 	  {
 	    char field_name[16];
 	    tree gnu_index_type = get_unpadded_type (Etype (gnat_index));
-	    tree gnu_index_base_type = get_base_type (gnu_index_type);
+	    tree gnu_index_base_type
+	      = maybe_character_type (get_base_type (gnu_index_type));
 	    tree gnu_lb_field, gnu_hb_field, gnu_orig_min, gnu_orig_max;
 	    tree gnu_min, gnu_max, gnu_high;
 
@@ -2363,7 +2382,8 @@ gnat_to_gnu_entity (Entity_Id gnat_entity, tree gnu_expr, int definition)
 	       gnat_base_index = Next_Index (gnat_base_index))
 	    {
 	      tree gnu_index_type = get_unpadded_type (Etype (gnat_index));
-	      tree gnu_index_base_type = get_base_type (gnu_index_type);
+	      tree gnu_index_base_type
+		= maybe_character_type (get_base_type (gnu_index_type));
 	      tree gnu_orig_min
 		= convert (gnu_index_base_type,
 			   TYPE_MIN_VALUE (gnu_index_type));
@@ -2375,7 +2395,7 @@ gnat_to_gnu_entity (Entity_Id gnat_entity, tree gnu_expr, int definition)
 	      tree gnu_base_index_type
 		= get_unpadded_type (Etype (gnat_base_index));
 	      tree gnu_base_index_base_type
-	        = get_base_type (gnu_base_index_type);
+	        = maybe_character_type (get_base_type (gnu_base_index_type));
 	      tree gnu_base_orig_min
 		= convert (gnu_base_index_base_type,
 			   TYPE_MIN_VALUE (gnu_base_index_type));

gcc/ada/gcc-interface/gigi.h

@@ -604,6 +604,9 @@ extern void build_dummy_unc_pointer_types (Entity_Id gnat_desig_type,
 extern void record_builtin_type (const char *name, tree type,
 				 bool artificial_p);
 
+/* Finish constructing the character type CHAR_TYPE.  */
+extern void finish_character_type (tree char_type);
+
 /* Given a record type RECORD_TYPE and a list of FIELD_DECL nodes FIELD_LIST,
    finish constructing the record type as a fat pointer type.  */
 extern void finish_fat_pointer_type (tree record_type, tree field_list);
@@ -1134,3 +1137,30 @@ gnat_signed_type_for (tree type_node)
 {
   return gnat_signed_or_unsigned_type_for (0, type_node);
 }
+
+/* Adjust the character type TYPE if need be.  */
+
+static inline tree
+maybe_character_type (tree type)
+{
+  if (TYPE_STRING_FLAG (type) && !TYPE_UNSIGNED (type))
+    type = gnat_unsigned_type_for (type);
+
+  return type;
+}
+
+/* Adjust the character value EXPR if need be.  */
+
+static inline tree
+maybe_character_value (tree expr)
+{
+  tree type = TREE_TYPE (expr);
+
+  if (TYPE_STRING_FLAG (type) && !TYPE_UNSIGNED (type))
+    {
+      type = gnat_unsigned_type_for (type);
+      expr = convert (type, expr);
+    }
+
+  return expr;
+}

gcc/ada/gcc-interface/lang.opt

@@ -76,6 +76,10 @@ fshort-enums
 Ada AdaWhy AdaSCIL
 Use the narrowest integer type possible for enumeration types.
 
+fsigned-char
+Ada AdaWhy AdaSCIL
+Make \"char\" signed by default.
+
 gant
 Ada AdaWhy AdaSCIL Joined Undocumented
 Catch typos.

gcc/ada/gcc-interface/misc.c

@@ -169,7 +169,8 @@ gnat_handle_option (size_t scode, const char *arg, int value, int kind,
       break;
 
     case OPT_fshort_enums:
-      /* This is handled by the middle-end.  */
+    case OPT_fsigned_char:
+      /* These are handled by the middle-end.  */
       break;
 
     case OPT_fbuiltin_printf:
@@ -353,8 +354,7 @@ static bool
 gnat_init (void)
 {
   /* Do little here, most of the standard declarations are set up after the
-     front-end has been run.  Use the same `char' as C, this doesn't really
+     front-end has been run.  Use the same `char' as C for Interfaces.C.  */
-     matter since we'll use the explicit `unsigned char' for Character.  */
   build_common_tree_nodes (flag_signed_char, false);
 
   /* In Ada, we use an unsigned 8-bit type for the default boolean type.  */

gcc/ada/gcc-interface/trans.c

@@ -231,7 +231,6 @@ static void elaborate_all_entities (Node_Id);
 static void process_freeze_entity (Node_Id);
 static void process_decls (List_Id, List_Id, Node_Id, bool, bool);
 static tree emit_range_check (tree, Node_Id, Node_Id);
-static tree emit_index_check (tree, tree, tree, tree, Node_Id);
 static tree emit_check (tree, tree, int, Node_Id);
 static tree build_unary_op_trapv (enum tree_code, tree, tree, Node_Id);
 static tree build_binary_op_trapv (enum tree_code, tree, tree, tree, Node_Id);
@@ -354,7 +353,7 @@ gigi (Node_Id gnat_root,
   /* Record the builtin types.  Define `integer' and `character' first so that
      dbx will output them first.  */
   record_builtin_type ("integer", integer_type_node, false);
-  record_builtin_type ("character", unsigned_char_type_node, false);
+  record_builtin_type ("character", char_type_node, false);
   record_builtin_type ("boolean", boolean_type_node, false);
   record_builtin_type ("void", void_type_node, false);
 
@@ -364,8 +363,9 @@ gigi (Node_Id gnat_root,
 		 false);
 
   /* Likewise for character as the type for Standard.Character.  */
+  finish_character_type (char_type_node);
   save_gnu_tree (Base_Type (standard_character),
-		 TYPE_NAME (unsigned_char_type_node),
+		 TYPE_NAME (char_type_node),
 		 false);
 
   /* Likewise for boolean as the type for Standard.Boolean.  */
@@ -544,21 +544,21 @@ gigi (Node_Id gnat_root,
   others_decl
     = create_var_decl (get_identifier ("OTHERS"),
 		       get_identifier ("__gnat_others_value"),
-		       unsigned_char_type_node, NULL_TREE,
+		       char_type_node, NULL_TREE,
 		       true, false, true, false, false, true, false,
 		       NULL, Empty);
 
   all_others_decl
     = create_var_decl (get_identifier ("ALL_OTHERS"),
 		       get_identifier ("__gnat_all_others_value"),
-		       unsigned_char_type_node, NULL_TREE,
+		       char_type_node, NULL_TREE,
 		       true, false, true, false, false, true, false,
 		       NULL, Empty);
 
   unhandled_others_decl
     = create_var_decl (get_identifier ("UNHANDLED_OTHERS"),
 		       get_identifier ("__gnat_unhandled_others_value"),
-		       unsigned_char_type_node, NULL_TREE,
+		       char_type_node, NULL_TREE,
 		       true, false, true, false, false, true, false,
 		       NULL, Empty);
 
@@ -571,8 +571,7 @@ gigi (Node_Id gnat_root,
 	= create_subprog_decl
 	  (get_identifier ("__gnat_last_chance_handler"), NULL_TREE,
 	   build_function_type_list (void_type_node,
-				     build_pointer_type
+				     build_pointer_type (char_type_node),
-				     (unsigned_char_type_node),
 				     integer_type_node, NULL_TREE),
 	   NULL_TREE, is_disabled, false, true, true, true, true, false,
 	   NULL, Empty);
@@ -720,8 +719,7 @@ build_raise_check (int check, enum exception_info_kind kind)
       Name_Buffer[Name_Len] = 0;
       ftype
 	= build_function_type_list (void_type_node,
-				    build_pointer_type
+				    build_pointer_type (char_type_node),
-				    (unsigned_char_type_node),
 				    integer_type_node, NULL_TREE);
     }
   else
@@ -732,8 +730,7 @@ build_raise_check (int check, enum exception_info_kind kind)
       Name_Buffer[Name_Len + 4] = 0;
       ftype
 	= build_function_type_list (void_type_node,
-				    build_pointer_type
+				    build_pointer_type (char_type_node),
-				    (unsigned_char_type_node),
 				    integer_type_node, integer_type_node,
 				    t, t, NULL_TREE);
     }
@@ -1547,7 +1544,7 @@ static tree
 get_type_length (tree type, tree result_type)
 {
   tree comp_type = get_base_type (result_type);
-  tree base_type = get_base_type (type);
+  tree base_type = maybe_character_type (get_base_type (type));
   tree lb = convert (base_type, TYPE_MIN_VALUE (type));
   tree hb = convert (base_type, TYPE_MAX_VALUE (type));
   tree length
@@ -1605,13 +1602,11 @@ Attribute_to_gnu (Node_Id gnat_node, tree *gnu_result_type_p, int attribute)
     case Attr_Val:
       /* These are just conversions since representation clauses for
 	 enumeration types are handled in the front-end.  */
-      {
+      gnu_expr = gnat_to_gnu (First (Expressions (gnat_node)));
-	bool checkp = Do_Range_Check (First (Expressions (gnat_node)));
+      if (attribute == Attr_Pos)
-	gnu_result = gnat_to_gnu (First (Expressions (gnat_node)));
+	gnu_expr = maybe_character_value (gnu_expr);
-	gnu_result_type = get_unpadded_type (Etype (gnat_node));
+      gnu_result_type = get_unpadded_type (Etype (gnat_node));
-	gnu_result = convert_with_check (Etype (gnat_node), gnu_result,
+      gnu_result = convert (gnu_result_type, gnu_expr);
-					 checkp, checkp, true, gnat_node);
-      }
       break;
 
     case Attr_Pred:
@@ -1620,24 +1615,12 @@ Attribute_to_gnu (Node_Id gnat_node, tree *gnu_result_type_p, int attribute)
 	 clauses for enumeration types are handled in the front-end.  */
       gnu_expr = gnat_to_gnu (First (Expressions (gnat_node)));
       gnu_result_type = get_unpadded_type (Etype (gnat_node));
-
+      gnu_type = maybe_character_type (gnu_result_type);
-      if (Do_Range_Check (First (Expressions (gnat_node))))
+      if (TREE_TYPE (gnu_expr) != gnu_type)
-	{
+	gnu_expr = convert (gnu_type, gnu_expr);
-	  gnu_expr = gnat_protect_expr (gnu_expr);
-	  gnu_expr
-	    = emit_check
-	      (build_binary_op (EQ_EXPR, boolean_type_node,
-				gnu_expr,
-				attribute == Attr_Pred
-				? TYPE_MIN_VALUE (gnu_result_type)
-				: TYPE_MAX_VALUE (gnu_result_type)),
-	       gnu_expr, CE_Range_Check_Failed, gnat_node);
-	}
-
       gnu_result
 	= build_binary_op (attribute == Attr_Pred ? MINUS_EXPR : PLUS_EXPR,
-			   gnu_result_type, gnu_expr,
+			   gnu_type, gnu_expr, build_int_cst (gnu_type, 1));
-			   build_int_cst (gnu_result_type, 1));
       break;
 
     case Attr_Address:
@@ -2877,7 +2860,7 @@ Loop_Statement_to_gnu (Node_Id gnat_node)
       Entity_Id gnat_loop_var = Defining_Entity (gnat_loop_spec);
       Entity_Id gnat_type = Etype (gnat_loop_var);
       tree gnu_type = get_unpadded_type (gnat_type);
-      tree gnu_base_type = get_base_type (gnu_type);
+      tree gnu_base_type = maybe_character_type (get_base_type (gnu_type));
       tree gnu_one_node = build_int_cst (gnu_base_type, 1);
       tree gnu_loop_var, gnu_loop_iv, gnu_first, gnu_last, gnu_stmt;
       enum tree_code update_code, test_code, shift_code;
@@ -5514,7 +5497,7 @@ Raise_Error_to_gnu (Node_Id gnat_node, tree *gnu_result_type_p)
       if (Present (gnat_cond) && Nkind (gnat_cond) == N_Op_Not)
 	{
 	  Node_Id gnat_range, gnat_index, gnat_type;
-	  tree gnu_index, gnu_low_bound, gnu_high_bound, disp;
+	  tree gnu_type, gnu_index, gnu_low_bound, gnu_high_bound, disp;
 	  bool neg_p;
 	  struct loop_info_d *loop;
 
@@ -5543,8 +5526,18 @@ Raise_Error_to_gnu (Node_Id gnat_node, tree *gnu_result_type_p)
 
 	  gnat_index = Left_Opnd (Right_Opnd (gnat_cond));
 	  gnat_type = Etype (gnat_index);
+	  gnu_type = maybe_character_type (get_unpadded_type (gnat_type));
 	  gnu_index = gnat_to_gnu (gnat_index);
 
+	  if (TREE_TYPE (gnu_index) != gnu_type)
+	    {
+	      if (gnu_low_bound)
+		gnu_low_bound = convert (gnu_type, gnu_low_bound);
+	      if (gnu_high_bound)
+		gnu_high_bound = convert (gnu_type, gnu_high_bound);
+	      gnu_index = convert (gnu_type, gnu_index);
+	    }
+
 	  if (with_extra_info
 	      && gnu_low_bound
 	      && gnu_high_bound
@@ -5589,7 +5582,7 @@ Raise_Error_to_gnu (Node_Id gnat_node, tree *gnu_result_type_p)
 	      rci->high_bound = gnu_high_bound;
 	      rci->disp = disp;
 	      rci->neg_p = neg_p;
-	      rci->type = get_unpadded_type (gnat_type);
+	      rci->type = gnu_type;
 	      rci->inserted_cond
 		= build1 (SAVE_EXPR, boolean_type_node, boolean_true_node);
 	      vec_safe_push (loop->checks, rci);
@@ -6156,8 +6149,6 @@ gnat_to_gnu (Node_Id gnat_node)
 	    = convert (TREE_TYPE (TYPE_FIELDS (TREE_TYPE (gnu_array_object))),
 		       gnu_array_object);
 
-	gnu_result = gnu_array_object;
-
 	/* The failure of this assertion will very likely come from a missing
 	   expansion for a packed array access.  */
 	gcc_assert (TREE_CODE (TREE_TYPE (gnu_array_object)) == ARRAY_TYPE);
@@ -6184,23 +6175,18 @@ gnat_to_gnu (Node_Id gnat_node)
 	       i++, gnat_temp = Next (gnat_temp))
 	    gnat_expr_array[i] = gnat_temp;
 
+	/* Start with the prefix and build the successive references.  */
+	gnu_result = gnu_array_object;
+
 	for (i = 0, gnu_type = TREE_TYPE (gnu_array_object);
 	     i < ndim;
 	     i++, gnu_type = TREE_TYPE (gnu_type))
 	  {
 	    gcc_assert (TREE_CODE (gnu_type) == ARRAY_TYPE);
 	    gnat_temp = gnat_expr_array[i];
-	    gnu_expr = gnat_to_gnu (gnat_temp);
+	    gnu_expr = maybe_character_value (gnat_to_gnu (gnat_temp));
 	    struct loop_info_d *loop;
 
-	    if (Do_Range_Check (gnat_temp))
-	      gnu_expr
-		= emit_index_check
-		  (gnu_array_object, gnu_expr,
-		   TYPE_MIN_VALUE (TYPE_INDEX_TYPE (TYPE_DOMAIN (gnu_type))),
-		   TYPE_MAX_VALUE (TYPE_INDEX_TYPE (TYPE_DOMAIN (gnu_type))),
-		   gnat_temp);
-
 	    gnu_result
 	      = build_binary_op (ARRAY_REF, NULL_TREE, gnu_result, gnu_expr);
 
@@ -6251,88 +6237,25 @@ gnat_to_gnu (Node_Id gnat_node)
 
     case N_Slice:
       {
-	Node_Id gnat_range_node = Discrete_Range (gnat_node);
+	tree gnu_array_object = gnat_to_gnu (Prefix (gnat_node));
-	tree gnu_type;
 
-	gnu_result = gnat_to_gnu (Prefix (gnat_node));
 	gnu_result_type = get_unpadded_type (Etype (gnat_node));
 
-	/* Do any implicit dereferences of the prefix and do any needed
+	gnu_array_object = maybe_implicit_deref (gnu_array_object);
-	   range check.  */
+	gnu_array_object = maybe_unconstrained_array (gnu_array_object);
-	gnu_result = maybe_implicit_deref (gnu_result);
-	gnu_result = maybe_unconstrained_array (gnu_result);
-	gnu_type = TREE_TYPE (gnu_result);
-	if (Do_Range_Check (gnat_range_node))
-	  {
-	    /* Get the bounds of the slice.  */
-	    tree gnu_index_type
-	      = TYPE_INDEX_TYPE (TYPE_DOMAIN (gnu_result_type));
-	    tree gnu_min_expr = TYPE_MIN_VALUE (gnu_index_type);
-	    tree gnu_max_expr = TYPE_MAX_VALUE (gnu_index_type);
-	    /* Get the permitted bounds.  */
-	    tree gnu_base_index_type
-	      = TYPE_INDEX_TYPE (TYPE_DOMAIN (gnu_type));
-	    tree gnu_base_min_expr = SUBSTITUTE_PLACEHOLDER_IN_EXPR
-	      (TYPE_MIN_VALUE (gnu_base_index_type), gnu_result);
-	    tree gnu_base_max_expr = SUBSTITUTE_PLACEHOLDER_IN_EXPR
-	      (TYPE_MAX_VALUE (gnu_base_index_type), gnu_result);
-	    tree gnu_expr_l, gnu_expr_h, gnu_expr_type;
 
-	   gnu_min_expr = gnat_protect_expr (gnu_min_expr);
+	gnu_expr = TYPE_MIN_VALUE (TYPE_DOMAIN (gnu_result_type));
-	   gnu_max_expr = gnat_protect_expr (gnu_max_expr);
+	gnu_expr = maybe_character_value (gnu_expr);
-
-	    /* Derive a good type to convert everything to.  */
-	    gnu_expr_type = get_base_type (gnu_index_type);
-
-	    /* Test whether the minimum slice value is too small.  */
-	    gnu_expr_l = build_binary_op (LT_EXPR, boolean_type_node,
-					  convert (gnu_expr_type,
-						   gnu_min_expr),
-					  convert (gnu_expr_type,
-						   gnu_base_min_expr));
-
-	    /* Test whether the maximum slice value is too large.  */
-	    gnu_expr_h = build_binary_op (GT_EXPR, boolean_type_node,
-					  convert (gnu_expr_type,
-						   gnu_max_expr),
-					  convert (gnu_expr_type,
-						   gnu_base_max_expr));
-
-	    /* Build a slice index check that returns the low bound,
-	       assuming the slice is not empty.  */
-	    gnu_expr = emit_check
-	      (build_binary_op (TRUTH_ORIF_EXPR, boolean_type_node,
-				gnu_expr_l, gnu_expr_h),
-	       gnu_min_expr, CE_Index_Check_Failed, gnat_node);
-
-	   /* Build a conditional expression that does the index checks and
-	      returns the low bound if the slice is not empty (max >= min),
-	      and returns the naked low bound otherwise (max < min), unless
-	      it is non-constant and the high bound is; this prevents VRP
-	      from inferring bogus ranges on the unlikely path.  */
-	    gnu_expr = fold_build3 (COND_EXPR, gnu_expr_type,
-				    build_binary_op (GE_EXPR, gnu_expr_type,
-						     convert (gnu_expr_type,
-							      gnu_max_expr),
-						     convert (gnu_expr_type,
-							      gnu_min_expr)),
-				    gnu_expr,
-				    TREE_CODE (gnu_min_expr) != INTEGER_CST
-				    && TREE_CODE (gnu_max_expr) == INTEGER_CST
-				    ? gnu_max_expr : gnu_min_expr);
-	  }
-	else
-	  /* Simply return the naked low bound.  */
-	  gnu_expr = TYPE_MIN_VALUE (TYPE_DOMAIN (gnu_result_type));
 
 	/* If this is a slice with non-constant size of an array with constant
 	   size, set the maximum size for the allocation of temporaries.  */
 	if (!TREE_CONSTANT (TYPE_SIZE_UNIT (gnu_result_type))
-	    && TREE_CONSTANT (TYPE_SIZE_UNIT (gnu_type)))
+	    && TREE_CONSTANT (TYPE_SIZE_UNIT (TREE_TYPE (gnu_array_object))))
-	  TYPE_ARRAY_MAX_SIZE (gnu_result_type) = TYPE_SIZE_UNIT (gnu_type);
+	  TYPE_ARRAY_MAX_SIZE (gnu_result_type)
+	    = TYPE_SIZE_UNIT (TREE_TYPE (gnu_array_object));
 
 	gnu_result = build_binary_op (ARRAY_RANGE_REF, gnu_result_type,
-				      gnu_result, gnu_expr);
+				      gnu_array_object, gnu_expr);
       }
       break;
 
@@ -6472,8 +6395,7 @@ gnat_to_gnu (Node_Id gnat_node)
 
     case N_Type_Conversion:
     case N_Qualified_Expression:
-      /* Get the operand expression.  */
+      gnu_expr = maybe_character_value (gnat_to_gnu (Expression (gnat_node)));
-      gnu_result = gnat_to_gnu (Expression (gnat_node));
       gnu_result_type = get_unpadded_type (Etype (gnat_node));
 
       /* If this is a qualified expression for a tagged type, we mark the type
@@ -6484,7 +6406,7 @@ gnat_to_gnu (Node_Id gnat_node)
 	used_types_insert (gnu_result_type);
 
       gnu_result
-	= convert_with_check (Etype (gnat_node), gnu_result,
+	= convert_with_check (Etype (gnat_node), gnu_expr,
 			      Do_Overflow_Check (gnat_node),
 			      Do_Range_Check (Expression (gnat_node)),
 			      kind == N_Type_Conversion
@@ -6492,11 +6414,12 @@ gnat_to_gnu (Node_Id gnat_node)
       break;
 
     case N_Unchecked_Type_Conversion:
-      gnu_result = gnat_to_gnu (Expression (gnat_node));
+      gnu_expr = maybe_character_value (gnat_to_gnu (Expression (gnat_node)));
 
       /* Skip further processing if the conversion is deemed a no-op.  */
       if (unchecked_conversion_nop (gnat_node))
 	{
+	  gnu_result = gnu_expr;
 	  gnu_result_type = TREE_TYPE (gnu_result);
 	  break;
 	}
@@ -6508,7 +6431,7 @@ gnat_to_gnu (Node_Id gnat_node)
       if (STRICT_ALIGNMENT && POINTER_TYPE_P (gnu_result_type)
 	  && IN (Ekind (Etype (gnat_node)), Access_Kind))
 	{
-	  unsigned int align = known_alignment (gnu_result);
+	  unsigned int align = known_alignment (gnu_expr);
 	  tree gnu_obj_type = TREE_TYPE (gnu_result_type);
 	  unsigned int oalign = TYPE_ALIGN (gnu_obj_type);
 
@@ -6522,11 +6445,11 @@ gnat_to_gnu (Node_Id gnat_node)
       /* If we are converting a descriptor to a function pointer, first
 	 build the pointer.  */
       if (TARGET_VTABLE_USES_DESCRIPTORS
-	  && TREE_TYPE (gnu_result) == fdesc_type_node
+	  && TREE_TYPE (gnu_expr) == fdesc_type_node
 	  && POINTER_TYPE_P (gnu_result_type))
-	gnu_result = build_unary_op (ADDR_EXPR, NULL_TREE, gnu_result);
+	gnu_expr = build_unary_op (ADDR_EXPR, NULL_TREE, gnu_expr);
 
-      gnu_result = unchecked_convert (gnu_result_type, gnu_result,
+      gnu_result = unchecked_convert (gnu_result_type, gnu_expr,
 				      No_Truncation (gnat_node));
       break;
 
@@ -6560,6 +6483,14 @@ gnat_to_gnu (Node_Id gnat_node)
 
 	gnu_result_type = get_unpadded_type (Etype (gnat_node));
 
+	tree gnu_op_type = maybe_character_type (TREE_TYPE (gnu_obj));
+	if (TREE_TYPE (gnu_obj) != gnu_op_type)
+	  {
+	    gnu_obj = convert (gnu_op_type, gnu_obj);
+	    gnu_low = convert (gnu_op_type, gnu_low);
+	    gnu_high = convert (gnu_op_type, gnu_high);
+	  }
+
 	/* If LOW and HIGH are identical, perform an equality test.  Otherwise,
 	   ensure that GNU_OBJ is evaluated only once and perform a full range
 	   test.  */
@@ -6660,6 +6591,13 @@ gnat_to_gnu (Node_Id gnat_node)
 	  {
 	    gnu_lhs = maybe_unconstrained_array (gnu_lhs);
 	    gnu_rhs = maybe_unconstrained_array (gnu_rhs);
+
+	    tree gnu_op_type = maybe_character_type (TREE_TYPE (gnu_lhs));
+	    if (TREE_TYPE (gnu_lhs) != gnu_op_type)
+	      {
+		gnu_lhs = convert (gnu_op_type, gnu_lhs);
+		gnu_rhs = convert (gnu_op_type, gnu_rhs);
+	      }
 	  }
 
 	/* If this is a shift whose count is not guaranteed to be correct,
@@ -9081,49 +9019,6 @@ emit_range_check (tree gnu_expr, Entity_Id gnat_range_type, Node_Id gnat_node)
      gnu_expr, CE_Range_Check_Failed, gnat_node);
 }
 
-/* Emit code for an index check.  GNU_ARRAY_OBJECT is the array object which
-   we are about to index, GNU_EXPR is the index expression to be checked,
-   GNU_LOW and GNU_HIGH are the lower and upper bounds against which GNU_EXPR
-   has to be checked.  Note that for index checking we cannot simply use the
-   emit_range_check function (although very similar code needs to be generated
-   in both cases) since for index checking the array type against which we are
-   checking the indices may be unconstrained and consequently we need to get
-   the actual index bounds from the array object itself (GNU_ARRAY_OBJECT).
-   The place where we need to do that is in subprograms having unconstrained
-   array formal parameters.  GNAT_NODE is the GNAT node conveying the source
-   location for which the error should be signaled.  */
-
-static tree
-emit_index_check (tree gnu_array_object, tree gnu_expr, tree gnu_low,
-		  tree gnu_high, Node_Id gnat_node)
-{
-  tree gnu_expr_check;
-
-  /* Checked expressions must be evaluated only once.  */
-  gnu_expr = gnat_protect_expr (gnu_expr);
-
-  /* Must do this computation in the base type in case the expression's
-     type is an unsigned subtypes.  */
-  gnu_expr_check = convert (get_base_type (TREE_TYPE (gnu_expr)), gnu_expr);
-
-  /* If GNU_LOW or GNU_HIGH are a PLACEHOLDER_EXPR, qualify them by
-     the object we are handling.  */
-  gnu_low = SUBSTITUTE_PLACEHOLDER_IN_EXPR (gnu_low, gnu_array_object);
-  gnu_high = SUBSTITUTE_PLACEHOLDER_IN_EXPR (gnu_high, gnu_array_object);
-
-  return emit_check
-    (build_binary_op (TRUTH_ORIF_EXPR, boolean_type_node,
-		      build_binary_op (LT_EXPR, boolean_type_node,
-				       gnu_expr_check,
-				       convert (TREE_TYPE (gnu_expr_check),
-						gnu_low)),
-		      build_binary_op (GT_EXPR, boolean_type_node,
-				       gnu_expr_check,
-				       convert (TREE_TYPE (gnu_expr_check),
-						gnu_high))),
-     gnu_expr, CE_Index_Check_Failed, gnat_node);
-}
-
 /* GNU_COND contains the condition corresponding to an index, overflow or
    range check of value GNU_EXPR.  Build a COND_EXPR that returns GNU_EXPR
    if GNU_COND is false and raises a CONSTRAINT_ERROR if GNU_COND is true.

gcc/ada/gcc-interface/utils.c

@@ -1595,6 +1595,48 @@ record_builtin_type (const char *name, tree type, bool artificial_p)
     debug_hooks->type_decl (type_decl, false);
 }
 
+/* Finish constructing the character type CHAR_TYPE.
+
+  In Ada character types are enumeration types and, as a consequence, are
+  represented in the front-end by integral types holding the positions of
+  the enumeration values as defined by the language, which means that the
+  integral types are unsigned.
+
+  Unfortunately the signedness of 'char' in C is implementation-defined
+  and GCC even has the option -fsigned-char to toggle it at run time.
+  Since GNAT's philosophy is to be compatible with C by default, to wit
+  Interfaces.C.char is defined as a mere copy of Character, we may need
+  to declare character types as signed types in GENERIC and generate the
+  necessary adjustments to make them behave as unsigned types.
+
+  The overall strategy is as follows: if 'char' is unsigned, do nothing;
+  if 'char' is signed, translate character types of CHAR_TYPE_SIZE and
+  character subtypes with RM_Size = Esize = CHAR_TYPE_SIZE into signed
+  types.  The idea is to ensure that the bit pattern contained in the
+  Esize'd objects is not changed, even though the numerical value will
+  be interpreted differently depending on the signedness.
+
+  For character types, the bounds are implicit and, therefore, need to
+  be adjusted.  Morever, the debug info needs the unsigned version.  */
+
+void
+finish_character_type (tree char_type)
+{
+  if (TYPE_UNSIGNED (char_type))
+    return;
+
+  /* Make a copy of the unsigned version since we'll modify it below.  */
+  tree unsigned_char_type = copy_type (gnat_unsigned_type_for (char_type));
+
+  TYPE_NAME (unsigned_char_type) = TYPE_NAME (char_type);
+  TYPE_STRING_FLAG (unsigned_char_type) = TYPE_STRING_FLAG (char_type);
+  TYPE_ARTIFICIAL (unsigned_char_type) = TYPE_ARTIFICIAL (char_type);
+
+  SET_TYPE_DEBUG_TYPE (char_type, unsigned_char_type);
+  SET_TYPE_RM_MIN_VALUE (char_type, TYPE_MIN_VALUE (unsigned_char_type));
+  SET_TYPE_RM_MAX_VALUE (char_type, TYPE_MAX_VALUE (unsigned_char_type));
+}
+
 /* Given a record type RECORD_TYPE and a list of FIELD_DECL nodes FIELD_LIST,
    finish constructing the record type as a fat pointer type.  */
 
@@ -3360,6 +3402,9 @@ gnat_type_for_mode (machine_mode mode, int unsignedp)
 tree
 gnat_signed_or_unsigned_type_for (int unsignedp, tree type_node)
 {
+  if (type_node == char_type_node)
+    return unsignedp ? unsigned_char_type_node : signed_char_type_node;
+
   tree type = gnat_type_for_size (TYPE_PRECISION (type_node), unsignedp);
 
   if (TREE_CODE (type_node) == INTEGER_TYPE && TYPE_MODULAR_P (type_node))

gcc/ada/gcc-interface/utils2.c

@@ -1804,7 +1804,7 @@ expand_sloc (Node_Id gnat_node, tree *filename, tree *line, tree *col)
 
   const int len = strlen (str);
   *filename = build_string (len, str);
-  TREE_TYPE (*filename) = build_array_type (unsigned_char_type_node,
+  TREE_TYPE (*filename) = build_array_type (char_type_node,
 					    build_index_type (size_int (len)));
   *line = build_int_cst (NULL_TREE, line_number);
   if (col)
@@ -1834,7 +1834,7 @@ build_call_raise (int msg, Node_Id gnat_node, char kind)
   return
     build_call_n_expr (fndecl, 2,
 		       build1 (ADDR_EXPR,
-			       build_pointer_type (unsigned_char_type_node),
+			       build_pointer_type (char_type_node),
 			       filename),
 		       line);
 }
@@ -1858,7 +1858,7 @@ build_call_raise_column (int msg, Node_Id gnat_node, char kind)
   return
     build_call_n_expr (fndecl, 3,
 		       build1 (ADDR_EXPR,
-			       build_pointer_type (unsigned_char_type_node),
+			       build_pointer_type (char_type_node),
 			       filename),
 		       line, col);
 }
@@ -1883,7 +1883,7 @@ build_call_raise_range (int msg, Node_Id gnat_node, char kind,
   return
     build_call_n_expr (fndecl, 6,
 		       build1 (ADDR_EXPR,
-			       build_pointer_type (unsigned_char_type_node),
+			       build_pointer_type (char_type_node),
 			       filename),
 		       line, col,
 		       convert (integer_type_node, index),