+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
+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
* 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
* 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.
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;
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,
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),
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;
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
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
{
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;
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:
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,
break;
case ENUMERAL_TYPE:
+ case BOOLEAN_TYPE:
print_node (file, "RM size", TYPE_RM_SIZE_NUM (node), indent + 4);
break;
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;
/* 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,
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. */
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);
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
{
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))
{
{
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))
{
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
/* ... 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:
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)
+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>
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.
--- /dev/null
+-- 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;
--- /dev/null
+package Boolean_Expr is
+
+ function S (V : in Long_Float) return String;
+
+end Boolean_Expr;