OpenE2K
/
gcc
2
0
Fork 0
Code Issues Pull Requests Projects Releases Wiki Activity

[multiple changes] 

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.

From-SVN: r194802
This commit is contained in:
Arnaud Charlet 2013-01-02 12:53:18 +01:00
parent 04b80dbb54
commit ca1ffed0e8
9 changed files with 130 additions and 37 deletions
Show Stats Download Patch File Download Diff File Expand all files Collapse all files

23
gcc/ada/ChangeLog
View File

@ -1,3 +1,26 @@
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.

11
gcc/ada/adaint.c
View File

@ -2963,7 +2963,10 @@ __gnat_locate_exec_on_path (char *exec_name)
/* __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)
{
@ -2999,6 +3002,12 @@ 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

14
gcc/ada/einfo.adb
View File

@ -285,6 +285,7 @@ package body Einfo is
-- 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
@ -527,7 +528,6 @@ package body Einfo is
-- Has_Anonymous_Master Flag253
-- Is_Implementation_Defined Flag254
-- (unused) Flag34
-- (unused) Flag201
-----------------------
@ -1338,6 +1338,12 @@ package body Einfo is
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));
@ -3853,6 +3859,12 @@ package body Einfo is
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));

37
gcc/ada/einfo.ads
View File

@ -528,7 +528,7 @@ package Einfo is
--
-- 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
@ -536,11 +536,11 @@ package Einfo is
-- 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.
@ -1547,6 +1547,19 @@ package Einfo is
-- 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
@ -1573,15 +1586,6 @@ package Einfo is
-- 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
@ -4902,6 +4906,7 @@ package Einfo is
-- 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)
@ -5102,6 +5107,7 @@ package Einfo is
-- 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)
@ -5769,6 +5775,7 @@ package Einfo is
-- 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)
@ -6154,6 +6161,7 @@ package Einfo is
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;
@ -6745,6 +6753,7 @@ package Einfo is
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);
@ -7424,6 +7433,7 @@ package Einfo is
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);
@ -7870,6 +7880,7 @@ package Einfo is
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);

46
gcc/ada/freeze.adb
View File

@ -802,17 +802,22 @@ package body Freeze is
-- 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
@ -856,6 +861,16 @@ package body Freeze is
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
@ -934,10 +949,19 @@ package body Freeze is
and then Is_Modular_Integer_Type
(Packed_Array_Type (Ctyp)))
then
-- If RM_Size is known and static, then we can keep
-- accumulating the packed size.
-- 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 Known_Static_RM_Size (Ctyp) then
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
elsif Known_Static_RM_Size (Ctyp) then
-- A little glitch, to be removed sometime ???
-- gigi does not understand zero sizes yet.
@ -1050,7 +1074,7 @@ package body Freeze is
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

4
gcc/ada/opt.ads
View File

@ -1618,11 +1618,11 @@ package Opt is
-- 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

10
gcc/ada/sem_attr.adb
View File

@ -1015,6 +1015,16 @@ package body Sem_Attr is
("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

18
gcc/ada/sem_prag.adb
View File

@ -10330,15 +10330,19 @@ package body Sem_Prag is
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);

4
gcc/ada/usage.adb
View File

@ -541,8 +541,8 @@ begin
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");