exp_ch2.adb (Expand_Current_Value): Make an appropriate character literal if the…

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

+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))
-	  || Is_Unsigned_Type (gnat_entity)
-	  || Has_Biased_Representation (gnat_entity))
+      if (kind == E_Enumeration_Subtype
+	  && No (First_Literal (Etype (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
-     matter since we'll use the explicit `unsigned char' for Character.  */
+     front-end has been run.  Use the same `char' as C for Interfaces.C.  */
   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/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),