+2013-01-02 Robert Dewar <dewar@adacore.com>
+
+ * einfo.ads, einfo.adb (Has_Independent_Components): New flag.
+ * freeze.adb (Size_Known): We do not know the size of a packed
+ record if it has atomic components, by reference type components,
+ or independent components.
+ * sem_prag.adb (Analyze_Pragma, case Independent_Components): Set new
+ flag Has_Independent_Components.
+
+2013-01-02 Yannick Moy <moy@adacore.com>
+
+ * opt.ads (Warn_On_Suspicious_Contract): Set to True by default.
+ * usage.adb (Usage): Update usage message.
+
+2013-01-02 Pascal Obry <obry@adacore.com>
+
+ * adaint.c (__gnat_is_module_name_supported): New constant.
+
+2013-01-02 Ed Schonberg <schonberg@adacore.com>
+
+ * sem_attr.adb (Check_Array_Type): Reject an attribute reference on an
+ array whose component type does not have a completion.
+
2013-01-02 Geert Bosch <bosch@adacore.com>
* a-nllcef.ads, a-nlcefu.ads, a-nscefu.ads: Make Pure.
/* __gnat_get_module_name returns the module name (executable or shared
library) in which the code at addr is. This is used to properly
report the symbolic tracebacks. If the module cannot be located
- it returns the empty string. The returned value must not be freed. */
+ it returns the empty string. The returned value must not be freed.
+
+ If this routine is fully implemented the value for
+ __gnat_is_module_name_supported should be set to 1. */
char *__gnat_get_module_name (void *addr ATTRIBUTE_UNUSED)
{
#endif
}
+#ifdef _WIN32
+int __gnat_is_module_name_supported = 1;
+#else
+int __gnat_is_module_name_supported = 0;
+#endif
+
#ifdef VMS
/* These functions are used to translate to and from VMS and Unix syntax
-- Checks_May_Be_Suppressed Flag31
-- Kill_Elaboration_Checks Flag32
-- Kill_Range_Checks Flag33
+ -- Has_Independent_Components Flag34
-- Is_Class_Wide_Equivalent_Type Flag35
-- Referenced_As_LHS Flag36
-- Is_Known_Non_Null Flag37
-- Has_Anonymous_Master Flag253
-- Is_Implementation_Defined Flag254
- -- (unused) Flag34
-- (unused) Flag201
-----------------------
return Flag251 (Id);
end Has_Implicit_Dereference;
+ function Has_Independent_Components (Id : E) return B is
+ begin
+ pragma Assert (Is_Object (Id) or else Is_Type (Id));
+ return Flag34 (Id);
+ end Has_Independent_Components;
+
function Has_Inheritable_Invariants (Id : E) return B is
begin
pragma Assert (Is_Type (Id));
Set_Flag251 (Id, V);
end Set_Has_Implicit_Dereference;
+ procedure Set_Has_Independent_Components (Id : E; V : B := True) is
+ begin
+ pragma Assert (Is_Object (Id) or else Is_Type (Id));
+ Set_Flag34 (Id, V);
+ end Set_Has_Independent_Components;
+
procedure Set_Has_Inheritable_Invariants (Id : E; V : B := True) is
begin
pragma Assert (Is_Type (Id));
--
-- Setting this False in all cases corresponds to the traditional back
-- end strategy, where all access-to-subprogram types are represented the
--- same way, independent of the Convention. See also
+-- same way, independent of the Convention. For further details, see also
-- Always_Compatible_Rep in Targparm.
--
-- Efficiency note: On targets that use dynamically generated
-- subprograms, whereas True generally favors efficiency of nested
-- ones. On other targets, this flag has little or no effect on
-- efficiency. The front end should take this into account. In
--- particular, pragma Favor_Top_Level gives a hint that the flag should
--- be False.
+-- particular, pragma Favor_Top_Level gives a hint that the flag
+-- should be False.
--
-- Note: We considered using Convention-C for this purpose, but we need
--- this separate flag, because Convention-C implies that for
+-- this separate flag, because Convention-C implies that in the case of
-- P'[Unrestricted_]Access, P also have convention C. Sometimes we want
-- to have Can_Use_Internal_Rep False for an access type, but allow P to
-- have convention Ada.
-- Implicit_Dereference. Set also on the discriminant named in the aspect
-- clause, to simplify type resolution.
+-- Has_Independent_Components (Flag34)
+-- Defined in objects and types. Set if the aspect Independent_Components
+-- applies (as set by coresponding pragma or aspect specification).
+
+-- Has_Inheritable_Invariants (Flag248)
+-- Defined in all type entities. Set True in private types from which one
+-- or more Invariant'Class aspects will be inherited if a another type is
+-- derived from the type (i.e. those types which have an Invariant'Class
+-- aspect, or which inherit one or more Invariant'Class aspects). Also
+-- set in the corresponding full types. Note that it might be the full
+-- type which has inheritable invariants, and in this case the flag will
+-- also be set in the private type.
+
-- Has_Initial_Value (Flag219)
-- Defined in entities for variables and out parameters. Set if there
-- is an explicit initial value expression in the declaration of the
-- the invariant procedure entity, to distinguish it among entries in the
-- Subprograms_For_Type.
--- Has_Inheritable_Invariants (Flag248)
--- Defined in all type entities. Set True in private types from which one
--- or more Invariant'Class aspects will be inherited if a another type is
--- derived from the type (i.e. those types which have an Invariant'Class
--- aspect, or which inherit one or more Invariant'Class aspects). Also
--- set in the corresponding full types. Note that it might be the full
--- type which has inheritable invariants, and in this case the flag will
--- also be set in the private type.
-
-- Has_Machine_Radix_Clause (Flag83)
-- Defined in decimal types and subtypes, set if a Machine_Radix
-- representation clause is present. This flag is used to detect
-- Has_Controlled_Component (Flag43) (base type only)
-- Has_Default_Aspect (Flag39) (base type only)
-- Has_Discriminants (Flag5)
+ -- Has_Independent_Components (Flag34) (base type only)
-- Has_Inheritable_Invariants (Flag248)
-- Has_Invariants (Flag232)
-- Has_Non_Standard_Rep (Flag75) (base type only)
-- Has_Atomic_Components (Flag86)
-- Has_Biased_Representation (Flag139)
-- Has_Completion (Flag26) (constants only)
+ -- Has_Independent_Components (Flag34) (base type only)
-- Has_Thunks (Flag228) (constants only)
-- Has_Size_Clause (Flag29)
-- Has_Up_Level_Access (Flag215)
-- Has_Alignment_Clause (Flag46)
-- Has_Atomic_Components (Flag86)
-- Has_Biased_Representation (Flag139)
+ -- Has_Independent_Components (Flag34) (base type only)
-- Has_Initial_Value (Flag219)
-- Has_Size_Clause (Flag29)
-- Has_Up_Level_Access (Flag215)
function Has_Gigi_Rep_Item (Id : E) return B;
function Has_Homonym (Id : E) return B;
function Has_Implicit_Dereference (Id : E) return B;
+ function Has_Independent_Components (Id : E) return B;
function Has_Inheritable_Invariants (Id : E) return B;
function Has_Initial_Value (Id : E) return B;
function Has_Interrupt_Handler (Id : E) return B;
procedure Set_Has_Gigi_Rep_Item (Id : E; V : B := True);
procedure Set_Has_Homonym (Id : E; V : B := True);
procedure Set_Has_Implicit_Dereference (Id : E; V : B := True);
+ procedure Set_Has_Independent_Components (Id : E; V : B := True);
procedure Set_Has_Inheritable_Invariants (Id : E; V : B := True);
procedure Set_Has_Initial_Value (Id : E; V : B := True);
procedure Set_Has_Invariants (Id : E; V : B := True);
pragma Inline (Has_Gigi_Rep_Item);
pragma Inline (Has_Homonym);
pragma Inline (Has_Implicit_Dereference);
+ pragma Inline (Has_Independent_Components);
pragma Inline (Has_Inheritable_Invariants);
pragma Inline (Has_Initial_Value);
pragma Inline (Has_Invariants);
pragma Inline (Set_Has_Gigi_Rep_Item);
pragma Inline (Set_Has_Homonym);
pragma Inline (Set_Has_Implicit_Dereference);
+ pragma Inline (Set_Has_Independent_Components);
pragma Inline (Set_Has_Inheritable_Invariants);
pragma Inline (Set_Has_Initial_Value);
pragma Inline (Set_Has_Invariants);
-- size of packed records if we can tell the size of the packed
-- record in the front end. Packed_Size_Known is True if so far
-- we can figure out the size. It is initialized to True for a
- -- packed record, unless the record has discriminants. The
- -- reason we eliminate the discriminated case is that we don't
- -- know the way the back end lays out discriminated packed
- -- records. If Packed_Size_Known is True, then Packed_Size is
- -- the size in bits so far.
+ -- packed record, unless the record has discriminants or atomic
+ -- components or independent components.
+
+ -- The reason we eliminate the discriminated case is that
+ -- we don't know the way the back end lays out discriminated
+ -- packed records. If Packed_Size_Known is True, then
+ -- Packed_Size is the size in bits so far.
Packed_Size_Known : Boolean :=
- Is_Packed (T)
- and then not Has_Discriminants (T);
+ Is_Packed (T)
+ and then not Has_Discriminants (T)
+ and then not Has_Atomic_Components (T)
+ and then not Has_Independent_Components (T);
Packed_Size : Uint := Uint_0;
+ -- SIze in bis so far
begin
-- Test for variant part present
Packed_Size_Known := False;
end if;
+ -- We do not know the packed size if we have a by reference
+ -- type, or an atomic type or an atomic component.
+
+ if Is_Atomic (Ctyp)
+ or else Is_Atomic (Comp)
+ or else Is_By_Reference_Type (Ctyp)
+ then
+ Packed_Size_Known := False;
+ end if;
+
-- We need to identify a component that is an array where
-- the index type is an enumeration type with non-standard
-- representation, and some bound of the type depends on a
and then Is_Modular_Integer_Type
(Packed_Array_Type (Ctyp)))
then
+ -- Packed size unknown if we have an atomic type
+ -- or a by reference type, since the back end
+ -- knows how these are layed out.
+
+ if Is_Atomic (Ctyp)
+ or else Is_By_Reference_Type (Ctyp)
+ then
+ Packed_Size_Known := False;
+
-- If RM_Size is known and static, then we can keep
- -- accumulating the packed size.
+ -- accumulating the packed size
- if Known_Static_RM_Size (Ctyp) then
+ elsif Known_Static_RM_Size (Ctyp) then
-- A little glitch, to be removed sometime ???
-- gigi does not understand zero sizes yet.
Comp_Byte_Aligned :=
Present (Component_Clause (Comp))
and then
- Normalized_First_Bit (Comp) mod System_Storage_Unit = 0;
+ Normalized_First_Bit (Comp) mod System_Storage_Unit = 0;
end if;
-- Array case
-- clauses that are affected by non-standard bit-order. The default is
-- that this warning is enabled. Modified by -gnatw.v/.V.
- Warn_On_Suspicious_Contract : Boolean := False;
+ Warn_On_Suspicious_Contract : Boolean := True;
-- GNAT
-- Set to True to generate warnings for suspicious contracts expressed as
-- pragmas or aspects precondition and postcondition. The default is that
- -- this warning is disabled. Modified by use of -gnatw.t/.T.
+ -- this warning is enabled. Modified by use of -gnatw.t/.T.
Warn_On_Suspicious_Modulus_Value : Boolean := True;
-- GNAT
("prefix for % attribute must be constrained array", P);
end if;
+ -- The attribute reference freezes the type, and thus the
+ -- component type, even if the attribute may not depend on the
+ -- component. Diagnose arrays with incomplete components now.
+ -- If the prefix is an access to array, this does not freeze
+ -- the designated type.
+
+ if Nkind (P) /= N_Explicit_Dereference then
+ Check_Fully_Declared (Component_Type (P_Type), P);
+ end if;
+
D := Number_Dimensions (P_Type);
else
D := Declaration_Node (E);
K := Nkind (D);
- if (K = N_Full_Type_Declaration
- and then (Is_Array_Type (E) or else Is_Record_Type (E)))
- or else
- ((Ekind (E) = E_Constant or else Ekind (E) = E_Variable)
- and then Nkind (D) = N_Object_Declaration
- and then Nkind (Object_Definition (D)) =
- N_Constrained_Array_Definition)
+ if K = N_Full_Type_Declaration
+ and then (Is_Array_Type (E) or else Is_Record_Type (E))
+ then
+ Independence_Checks.Append ((N, E));
+ Set_Has_Independent_Components (Base_Type (E));
+
+ elsif (Ekind (E) = E_Constant or else Ekind (E) = E_Variable)
+ and then Nkind (D) = N_Object_Declaration
+ and then Nkind (Object_Definition (D)) =
+ N_Constrained_Array_Definition
then
Independence_Checks.Append ((N, E));
+ Set_Has_Independent_Components (E);
else
Error_Pragma_Arg ("inappropriate entity for pragma%", Arg1);
Write_Line (" .S* turn off warnings for overridden size clause");
Write_Line (" t turn on warnings for tracking deleted code");
Write_Line (" T* turn off warnings for tracking deleted code");
- Write_Line (" .t+ turn on warnings for suspicious contract");
- Write_Line (" .T* turn off warnings for suspicious contract");
+ Write_Line (" .t*+ turn on warnings for suspicious contract");
+ Write_Line (" .T turn off warnings for suspicious contract");
Write_Line (" u+ turn on warnings for unused entity");
Write_Line (" U* turn off warnings for unused entity");
Write_Line (" .u turn on warnings for unordered enumeration");
projects / thirdparty / gcc.git / commitdiff
