PR ada/36554

        * dwarf2out.c (is_subrange_type): Deal with BOOLEAN_TYPE.
ada/
        * back_end.adb (Call_Back_End): Pass Standard_Boolean to gigi.
        * gcc-interface/gigi.h (gigi): Take new standard_boolean parameter.
        * gcc-interface/decl.c (gnat_to_gnu_entity) <E_Enumeration_Subtype>:
        Set precision to 1 for subtype of BOOLEAN_TYPE.
        (set_rm_size): Set TYPE_RM_SIZE_NUM for BOOLEAN_TYPE.
        (make_type_from_size): Deal with BOOLEAN_TYPE.
        * gcc-interface/misc.c (gnat_print_type): Likewise.
        * gcc-interface/trans.c (gigi): Take new standard_boolean parameter.
        Set boolean_type_node as its translation in the table, as well
        as boolean_false_node for False and boolean_true_node for True.
        * gcc-interface/utils.c (gnat_init_decl_processing): Create custom
        8-bit boolean_type_node and set its TYPE_RM_SIZE_NUM.
        (create_param_decl): Deal with BOOLEAN_TYPE.
        (build_vms_descriptor): Likewise.
        (build_vms_descriptor64): Likewise.
        (convert): Deal with BOOLEAN_TYPE like with ENUMERAL_TYPE.


git-svn-id: svn+ssh://gcc.gnu.org/svn/gcc/trunk@138348 138bc75d-0d04-0410-961f-82ee72b054a4

12 files changed, 138 insertions, 18 deletions

diff --git a/gcc/ChangeLog b/gcc/ChangeLog
index e2b535a9e74..3584c53ca45 100644
--- a/gcc/ChangeLog
+++ b/gcc/ChangeLog
@@ -1,3 +1,8 @@
+2008-07-30  Eric Botcazou  <ebotcazou@adacore.com>
+
+	PR ada/36554
+	* dwarf2out.c (is_subrange_type): Deal with BOOLEAN_TYPE.
+
 2008-07-30  Rafael Avila de Espindola  <espindola@google.com>
 
 	PR 36974
diff --git a/gcc/ada/ChangeLog b/gcc/ada/ChangeLog
index b000c134db6..36c493e7ab5 100644
--- a/gcc/ada/ChangeLog
+++ b/gcc/ada/ChangeLog
@@ -1,3 +1,23 @@
+2008-07-30  Eric Botcazou  <ebotcazou@adacore.com>
+
+	PR ada/36554
+	* back_end.adb (Call_Back_End): Pass Standard_Boolean to gigi.
+	* gcc-interface/gigi.h (gigi): Take new standard_boolean parameter.
+	* gcc-interface/decl.c (gnat_to_gnu_entity) <E_Enumeration_Subtype>:
+	Set precision to 1 for subtype of BOOLEAN_TYPE.
+	(set_rm_size): Set TYPE_RM_SIZE_NUM for BOOLEAN_TYPE.
+	(make_type_from_size): Deal with BOOLEAN_TYPE.
+	* gcc-interface/misc.c (gnat_print_type): Likewise.
+	* gcc-interface/trans.c (gigi): Take new standard_boolean parameter.
+	Set boolean_type_node as its translation in the table, as well
+	as boolean_false_node for False and boolean_true_node for True.
+	* gcc-interface/utils.c (gnat_init_decl_processing): Create custom
+	8-bit boolean_type_node and set its TYPE_RM_SIZE_NUM.
+	(create_param_decl): Deal with BOOLEAN_TYPE.
+	(build_vms_descriptor): Likewise.
+	(build_vms_descriptor64): Likewise.
+	(convert): Deal with BOOLEAN_TYPE like with ENUMERAL_TYPE.
+
 2008-07-30  Robert Dewar  <dewar@adacore.com>
 
 	* exp_ch9.adb: Minor reformatting
@@ -16948,7 +16968,7 @@ PR ada/10768
 	* utils.c (create_var_decl): Use have_global_bss_p when deciding
 	whether to make the decl common.
 
-2006-02-20  Rafael Ávila de Espíndola  <rafael.espindola@gmail.com>
+2006-02-20  Rafael �vila de Esp�ndola  <rafael.espindola@gmail.com>
 
 	* Make-lang.in (Ada): Remove.
 	(.PHONY): Remove Ada
@@ -19406,11 +19426,11 @@ PR ada/10768
 
 	* s-bitops.adb: Clarify comment for Bits_Array
 
-2005-12-07  Rafael Ávila de Espíndola  <rafael.espindola@gmail.com>
+2005-12-07  Rafael �vila de Esp�ndola  <rafael.espindola@gmail.com>
 
 	* Make-lang.in (ada.install-normal): Remove.
 
-2005-12-07  Rafael Ávila de Espíndola  <rafael.espindola@gmail.com>
+2005-12-07  Rafael �vila de Esp�ndola  <rafael.espindola@gmail.com>
 
 	* Make-lang.in: Remove all dependencies on s-gtype.
 
diff --git a/gcc/ada/back_end.adb b/gcc/ada/back_end.adb
index a6600764988..7a4e4dadf0f 100644
--- a/gcc/ada/back_end.adb
+++ b/gcc/ada/back_end.adb
@@ -76,6 +76,7 @@ package body Back_End is
          number_file                   : Nat;
 
          file_info_ptr                 : Address;
+         gigi_standard_boolean         : Entity_Id;
          gigi_standard_integer         : Entity_Id;
          gigi_standard_long_long_float : Entity_Id;
          gigi_standard_exception_type  : Entity_Id;
@@ -112,6 +113,7 @@ package body Back_End is
          number_file        => Num_Source_Files,
 
          file_info_ptr                 => File_Info_Array'Address,
+         gigi_standard_boolean         => Standard_Boolean,
          gigi_standard_integer         => Standard_Integer,
          gigi_standard_long_long_float => Standard_Long_Long_Float,
          gigi_standard_exception_type  => Standard_Exception_Type,
diff --git a/gcc/ada/gcc-interface/decl.c b/gcc/ada/gcc-interface/decl.c
index 61ae653de2a..b02b9a04132 100644
--- a/gcc/ada/gcc-interface/decl.c
+++ b/gcc/ada/gcc-interface/decl.c
@@ -1536,15 +1536,20 @@ gnat_to_gnu_entity (Entity_Id gnat_entity, tree gnu_expr, int definition)
 			    gnu_expr, 0);
 
       gnu_type = make_node (INTEGER_TYPE);
+      TREE_TYPE (gnu_type) = get_unpadded_type (Etype (gnat_entity));
+
+      /* Set the precision to the Esize except for bit-packed arrays and
+	 subtypes of Standard.Boolean.  */
       if (Is_Packed_Array_Type (gnat_entity)
 	  && Is_Bit_Packed_Array (Original_Array_Type (gnat_entity)))
 	{
 	  esize = UI_To_Int (RM_Size (gnat_entity));
 	  TYPE_PACKED_ARRAY_TYPE_P (gnu_type) = 1;
 	}
+      else if (TREE_CODE (TREE_TYPE (gnu_type)) == BOOLEAN_TYPE)
+        esize = 1;
 
       TYPE_PRECISION (gnu_type) = esize;
-      TREE_TYPE (gnu_type) = get_unpadded_type (Etype (gnat_entity));
 
       TYPE_MIN_VALUE (gnu_type)
 	= convert (TREE_TYPE (gnu_type),
@@ -1596,7 +1601,7 @@ gnat_to_gnu_entity (Entity_Id gnat_entity, tree gnu_expr, int definition)
 	 are uninitialized.  Both goals are accomplished by wrapping the
 	 modular value in an enclosing struct.  */
       if (Is_Packed_Array_Type (gnat_entity)
-	    && Is_Bit_Packed_Array (Original_Array_Type (gnat_entity)))
+	  && Is_Bit_Packed_Array (Original_Array_Type (gnat_entity)))
 	{
 	  tree gnu_field_type = gnu_type;
 	  tree gnu_field;
@@ -7106,7 +7111,8 @@ set_rm_size (Uint uint_size, tree gnu_type, Entity_Id gnat_entity)
   if (TREE_CODE (gnu_type) == INTEGER_TYPE
       && Is_Discrete_Or_Fixed_Point_Type (gnat_entity))
     TYPE_RM_SIZE_NUM (gnu_type) = size;
-  else if (TREE_CODE (gnu_type) == ENUMERAL_TYPE)
+  else if (TREE_CODE (gnu_type) == ENUMERAL_TYPE
+	   || TREE_CODE (gnu_type) == BOOLEAN_TYPE)
     TYPE_RM_SIZE_NUM (gnu_type) = size;
   else if ((TREE_CODE (gnu_type) == RECORD_TYPE
 	    || TREE_CODE (gnu_type) == UNION_TYPE
@@ -7124,7 +7130,7 @@ static tree
 make_type_from_size (tree type, tree size_tree, bool for_biased)
 {
   unsigned HOST_WIDE_INT size;
-  bool biased_p;
+  bool biased_p, boolean_p;
   tree new_type;
 
   /* If size indicates an error, just return TYPE to avoid propagating
@@ -7138,13 +7144,23 @@ make_type_from_size (tree type, tree size_tree, bool for_biased)
     {
     case INTEGER_TYPE:
     case ENUMERAL_TYPE:
+    case BOOLEAN_TYPE:
       biased_p = (TREE_CODE (type) == INTEGER_TYPE
 		  && TYPE_BIASED_REPRESENTATION_P (type));
 
+      boolean_p = (TREE_CODE (type) == BOOLEAN_TYPE
+		   || (TREE_CODE (type) == INTEGER_TYPE
+		       && TREE_TYPE (type)
+		       && TREE_CODE (TREE_TYPE (type)) == BOOLEAN_TYPE));
+
+      if (boolean_p)
+	size = round_up_to_align (size, BITS_PER_UNIT);
+
       /* Only do something if the type is not a packed array type and
 	 doesn't already have the proper size.  */
       if (TYPE_PACKED_ARRAY_TYPE_P (type)
-	  || (TYPE_PRECISION (type) == size && biased_p == for_biased))
+	  || (biased_p == for_biased && TYPE_PRECISION (type) == size)
+	  || (boolean_p && compare_tree_int (TYPE_SIZE (type), size) == 0))
 	break;
 
       biased_p |= for_biased;
@@ -7154,13 +7170,18 @@ make_type_from_size (tree type, tree size_tree, bool for_biased)
 	new_type = make_unsigned_type (size);
       else
 	new_type = make_signed_type (size);
+      if (boolean_p)
+	TYPE_PRECISION (new_type) = 1;
       TREE_TYPE (new_type) = TREE_TYPE (type) ? TREE_TYPE (type) : type;
       TYPE_MIN_VALUE (new_type)
 	= convert (TREE_TYPE (new_type), TYPE_MIN_VALUE (type));
       TYPE_MAX_VALUE (new_type)
 	= convert (TREE_TYPE (new_type), TYPE_MAX_VALUE (type));
       TYPE_BIASED_REPRESENTATION_P (new_type) = biased_p;
-      TYPE_RM_SIZE_NUM (new_type) = bitsize_int (size);
+      if (boolean_p)
+	TYPE_RM_SIZE_NUM (new_type) = bitsize_int (1);
+      else
+	TYPE_RM_SIZE_NUM (new_type) = bitsize_int (size);
       return new_type;
 
     case RECORD_TYPE:
diff --git a/gcc/ada/gcc-interface/gigi.h b/gcc/ada/gcc-interface/gigi.h
index 685bb383bbd..8055359863c 100644
--- a/gcc/ada/gcc-interface/gigi.h
+++ b/gcc/ada/gcc-interface/gigi.h
@@ -218,6 +218,7 @@ extern void gigi (Node_Id gnat_root, int max_gnat_node, int number_name,
                   struct List_Header *list_headers_ptr,
                   Nat number_file,
                   struct File_Info_Type *file_info_ptr,
+                  Entity_Id standard_boolean,
                   Entity_Id standard_integer,
                   Entity_Id standard_long_long_float,
                   Entity_Id standard_exception_type,
diff --git a/gcc/ada/gcc-interface/misc.c b/gcc/ada/gcc-interface/misc.c
index 02397d7f445..47d249a4578 100644
--- a/gcc/ada/gcc-interface/misc.c
+++ b/gcc/ada/gcc-interface/misc.c
@@ -544,6 +544,7 @@ gnat_print_type (FILE *file, tree node, int indent)
       break;
 
     case ENUMERAL_TYPE:
+    case BOOLEAN_TYPE:
       print_node (file, "RM size", TYPE_RM_SIZE_NUM (node), indent + 4);
       break;
 
diff --git a/gcc/ada/gcc-interface/trans.c b/gcc/ada/gcc-interface/trans.c
index 3b15e30a222..9d3f807c6e6 100644
--- a/gcc/ada/gcc-interface/trans.c
+++ b/gcc/ada/gcc-interface/trans.c
@@ -231,12 +231,12 @@ gigi (Node_Id gnat_root, int max_gnat_node, int number_name,
       struct Elist_Header *elists_ptr, struct Elmt_Item *elmts_ptr,
       struct String_Entry *strings_ptr, Char_Code *string_chars_ptr,
       struct List_Header *list_headers_ptr, Nat number_file,
-      struct File_Info_Type *file_info_ptr,
+      struct File_Info_Type *file_info_ptr, Entity_Id standard_boolean,
       Entity_Id standard_integer, Entity_Id standard_long_long_float,
       Entity_Id standard_exception_type, Int gigi_operating_mode)
 {
-  tree gnu_standard_long_long_float;
-  tree gnu_standard_exception_type;
+  Entity_Id gnat_literal;
+  tree gnu_standard_long_long_float, gnu_standard_exception_type, t;
   struct elab_info *info;
   int i;
 
@@ -311,6 +311,8 @@ gigi (Node_Id gnat_root, int max_gnat_node, int number_name,
   /* Give names and make TYPE_DECLs for common types.  */
   create_type_decl (get_identifier (SIZE_TYPE), sizetype,
 		    NULL, false, true, Empty);
+  create_type_decl (get_identifier ("boolean"), boolean_type_node,
+		    NULL, false, true, Empty);
   create_type_decl (get_identifier ("integer"), integer_type_node,
 		    NULL, false, true, Empty);
   create_type_decl (get_identifier ("unsigned char"), char_type_node,
@@ -318,6 +320,26 @@ gigi (Node_Id gnat_root, int max_gnat_node, int number_name,
   create_type_decl (get_identifier ("long integer"), long_integer_type_node,
 		    NULL, false, true, Empty);
 
+  /* Save the type we made for boolean as the type for Standard.Boolean.  */
+  save_gnu_tree (Base_Type (standard_boolean), TYPE_NAME (boolean_type_node),
+		 false);
+  gnat_literal = First_Literal (Base_Type (standard_boolean));
+  t = UI_To_gnu (Enumeration_Rep (gnat_literal), boolean_type_node);
+  gcc_assert (t == boolean_false_node);
+  t = create_var_decl (get_entity_name (gnat_literal), NULL_TREE,
+		       boolean_type_node, t, true, false, false, false,
+		       NULL, gnat_literal);
+  DECL_IGNORED_P (t) = 1;
+  save_gnu_tree (gnat_literal, t, false);
+  gnat_literal = Next_Literal (gnat_literal);
+  t = UI_To_gnu (Enumeration_Rep (gnat_literal), boolean_type_node);
+  gcc_assert (t == boolean_true_node);
+  t = create_var_decl (get_entity_name (gnat_literal), NULL_TREE,
+		       boolean_type_node, t, true, false, false, false,
+		       NULL, gnat_literal);
+  DECL_IGNORED_P (t) = 1;
+  save_gnu_tree (gnat_literal, t, false);
+
   /* Save the type we made for integer as the type for Standard.Integer.
      Then make the rest of the standard types.  Note that some of these
      may be subtypes.  */
diff --git a/gcc/ada/gcc-interface/utils.c b/gcc/ada/gcc-interface/utils.c
index 01cc9b8948e..882293895cc 100644
--- a/gcc/ada/gcc-interface/utils.c
+++ b/gcc/ada/gcc-interface/utils.c
@@ -523,6 +523,13 @@ gnat_init_decl_processing (void)
      this before we can expand the GNAT types.  */
   size_type_node = gnat_type_for_size (GET_MODE_BITSIZE (Pmode), 0);
   set_sizetype (size_type_node);
+
+  /* In Ada, we use an unsigned 8-bit type for the default boolean type.  */
+  boolean_type_node = make_node (BOOLEAN_TYPE);
+  TYPE_PRECISION (boolean_type_node) = 1;
+  fixup_unsigned_type (boolean_type_node);
+  TYPE_RM_SIZE_NUM (boolean_type_node) = bitsize_int (1);
+
   build_common_tree_nodes_2 (0);
 
   ptr_void_type_node = build_pointer_type (void_type_node);
@@ -1762,7 +1769,8 @@ create_param_decl (tree param_name, tree param_type, bool readonly)
      lead to various ABI violations.  */
   if (targetm.calls.promote_prototypes (param_type)
       && (TREE_CODE (param_type) == INTEGER_TYPE
-	  || TREE_CODE (param_type) == ENUMERAL_TYPE)
+	  || TREE_CODE (param_type) == ENUMERAL_TYPE
+	  || TREE_CODE (param_type) == BOOLEAN_TYPE)
       && TYPE_PRECISION (param_type) < TYPE_PRECISION (integer_type_node))
     {
       /* We have to be careful about biased types here.  Make a subtype
@@ -2690,6 +2698,7 @@ build_vms_descriptor (tree type, Mechanism_Type mech, Entity_Id gnat_entity)
     {
     case INTEGER_TYPE:
     case ENUMERAL_TYPE:
+    case BOOLEAN_TYPE:
       if (TYPE_VAX_FLOATING_POINT_P (type))
 	switch (tree_low_cst (TYPE_DIGITS_VALUE (type), 1))
 	  {
@@ -2992,6 +3001,7 @@ build_vms_descriptor64 (tree type, Mechanism_Type mech, Entity_Id gnat_entity)
     {
     case INTEGER_TYPE:
     case ENUMERAL_TYPE:
+    case BOOLEAN_TYPE:
       if (TYPE_VAX_FLOATING_POINT_P (type))
 	switch (tree_low_cst (TYPE_DIGITS_VALUE (type), 1))
 	  {
@@ -4035,9 +4045,6 @@ convert (tree type, tree expr)
     case VOID_TYPE:
       return fold_build1 (CONVERT_EXPR, type, expr);
 
-    case BOOLEAN_TYPE:
-      return fold_convert (type, gnat_truthvalue_conversion (expr));
-
     case INTEGER_TYPE:
       if (TYPE_HAS_ACTUAL_BOUNDS_P (type)
 	  && (ecode == ARRAY_TYPE || ecode == UNCONSTRAINED_ARRAY_TYPE
@@ -4052,6 +4059,7 @@ convert (tree type, tree expr)
       /* ... fall through ... */
 
     case ENUMERAL_TYPE:
+    case BOOLEAN_TYPE:
       /* If we are converting an additive expression to an integer type
 	 with lower precision, be wary of the optimization that can be
 	 applied by convert_to_integer.  There are 2 problematic cases:
diff --git a/gcc/dwarf2out.c b/gcc/dwarf2out.c
index 72514a61a27..f553f2e454a 100644
--- a/gcc/dwarf2out.c
+++ b/gcc/dwarf2out.c
@@ -8846,7 +8846,8 @@ is_subrange_type (const_tree type)
     return false;
 
   if (TREE_CODE (subtype) != INTEGER_TYPE
-      && TREE_CODE (subtype) != ENUMERAL_TYPE)
+      && TREE_CODE (subtype) != ENUMERAL_TYPE
+      && TREE_CODE (subtype) != BOOLEAN_TYPE)
     return false;
 
   if (TREE_CODE (type) == TREE_CODE (subtype)
diff --git a/gcc/testsuite/ChangeLog b/gcc/testsuite/ChangeLog
index ab4b945f30d..a4025292059 100644
--- a/gcc/testsuite/ChangeLog
+++ b/gcc/testsuite/ChangeLog
@@ -1,3 +1,7 @@
+2008-07-30  Eric Botcazou  <ebotcazou@adacore.com>
+
+	* gnat.dg/boolean_expr.ad[sb]: New test.
+
 2008-07-30  H.J. Lu  <hongjiu.lu@intel.com>
 	    Joey Ye  <joey.ye@intel.com>
 
@@ -3666,7 +3670,7 @@
 	PR fortran/35780
 	* gfortran.dg/simplify_argN_1.f90: New test.
 
-2008-04-06  Tobias Schlüter  <tobi@gcc.gnu.org>
+2008-04-06  Tobias Schl�ter  <tobi@gcc.gnu.org>
 
 	PR fortran/35832
 	* gfortran.dg/io_constraints_2.f90: Adapt to new error message.
diff --git a/gcc/testsuite/gnat.dg/boolean_expr.adb b/gcc/testsuite/gnat.dg/boolean_expr.adb
new file mode 100644
index 00000000000..6ac086dfe6d
--- /dev/null
+++ b/gcc/testsuite/gnat.dg/boolean_expr.adb
@@ -0,0 +1,30 @@
+-- PR middle-end/36554
+-- Origin: Laurent Guerby <laurent@guerby.net>
+
+-- { dg-do compile }
+-- { dg-options "-O2" }
+
+package body Boolean_Expr is
+
+   function Long_Float_Is_Valid (X : in Long_Float) return Boolean is
+      Is_Nan : constant Boolean := X /= X;
+      Is_P_Inf : constant Boolean := X > Long_Float'Last;
+      Is_M_Inf : constant Boolean := X < Long_Float'First;
+      Is_Invalid : constant Boolean := Is_Nan or Is_P_Inf or Is_M_Inf;
+   begin
+      return not Is_Invalid;
+   end Long_Float_Is_Valid;
+
+   function S (V : in Long_Float) return String is
+   begin
+      if not Long_Float_Is_Valid (V) then
+         return "INVALID";
+      else
+         return "OK";
+      end if;
+   exception
+      when others =>
+         return "ERROR";
+   end S;
+
+end Boolean_Expr;
diff --git a/gcc/testsuite/gnat.dg/boolean_expr.ads b/gcc/testsuite/gnat.dg/boolean_expr.ads
new file mode 100644
index 00000000000..8190ce77bd5
--- /dev/null
+++ b/gcc/testsuite/gnat.dg/boolean_expr.ads
@@ -0,0 +1,5 @@
+package Boolean_Expr is
+
+   function S (V : in Long_Float) return String;
+
+end Boolean_Expr;