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

[multiple changes]

Browse Source 
2016-07-04  Hristian Kirtchev  <kirtchev@adacore.com>

	* freeze.adb, ghost.adb, sem_ch13.adb: Minor reformatting.

2016-07-04  Pascal Obry  <obry@adacore.com>

	* g-forstr.ads: More documentation for the Formatted_String
	support.

2016-07-04  Justin Squirek  <squirek@adacore.com>

	* sem_ch7.adb (Install_Parent_Private_Declarations): When
	instantiating a child unit, do not install private declaration of
	a non-generic ancestor of the generic that is also an ancestor
	of the current unit: its private part will be installed when
	private part of ancestor itself is analyzed.

2016-07-04  Ed Schonberg  <schonberg@adacore.com>

	* sem_ch12.adb (Instantiate_Object): In SPARK mode add a guard
	to verify that the actual is an object reference before checking
	for volatility.
	(Check_Generic_Child_Unit): Prevent cascaded errors when prefix
	is illegal.

From-SVN: r237969
This commit is contained in:
Arnaud Charlet 2016-07-04 12:41:23 +02:00
parent d4b56371aa
commit c70cf4f8eb
7 changed files with 96 additions and 46 deletions
Show Stats Download Patch File Download Diff File Expand all files Collapse all files

25
gcc/ada/ChangeLog
View File

@ -1,3 +1,28 @@
2016-07-04 Hristian Kirtchev <kirtchev@adacore.com>
* freeze.adb, ghost.adb, sem_ch13.adb: Minor reformatting.
2016-07-04 Pascal Obry <obry@adacore.com>
* g-forstr.ads: More documentation for the Formatted_String
support.
2016-07-04 Justin Squirek <squirek@adacore.com>
* sem_ch7.adb (Install_Parent_Private_Declarations): When
instantiating a child unit, do not install private declaration of
a non-generic ancestor of the generic that is also an ancestor
of the current unit: its private part will be installed when
private part of ancestor itself is analyzed.
2016-07-04 Ed Schonberg <schonberg@adacore.com>
* sem_ch12.adb (Instantiate_Object): In SPARK mode add a guard
to verify that the actual is an object reference before checking
for volatility.
(Check_Generic_Child_Unit): Prevent cascaded errors when prefix
is illegal.
2016-07-04 Gary Dismukes <dismukes@adacore.com>
* sem_ch12.ads, freeze.adb: Minor reformatting and typo fixes.

59
gcc/ada/freeze.adb
View File

@ -3561,32 +3561,11 @@ package body Freeze is
Junk : Boolean;
pragma Warnings (Off, Junk);
Rec_Pushed : Boolean := False;
-- Set True if the record type scope Rec has been pushed on the scope
-- stack. Needed for the analysis of delayed aspects specified to the
-- components of Rec.
SSO_ADC : Node_Id;
-- Scalar_Storage_Order attribute definition clause for the record
Unplaced_Component : Boolean := False;
-- Set True if we find at least one component with no component
-- clause (used to warn about useless Pack pragmas).
Placed_Component : Boolean := False;
-- Set True if we find at least one component with a component
-- clause (used to warn about useless Bit_Order pragmas, and also
-- to detect cases where Implicit_Packing may have an effect).
Aliased_Component : Boolean := False;
-- Set True if we find at least one component which is aliased. This
-- is used to prevent Implicit_Packing of the record, since packing
-- cannot modify the size of alignment of an aliased component.
SSO_ADC_Component : Boolean := False;
-- Set True if we find at least one component whose type has a
-- Scalar_Storage_Order attribute definition clause.
All_Elem_Components : Boolean := True;
-- Set False if we encounter a component of a composite type
@ -3601,10 +3580,31 @@ package body Freeze is
-- Accumulates total Esize values of all elementary components. Used
-- for processing of Implicit_Packing.
Placed_Component : Boolean := False;
-- Set True if we find at least one component with a component
-- clause (used to warn about useless Bit_Order pragmas, and also
-- to detect cases where Implicit_Packing may have an effect).
Rec_Pushed : Boolean := False;
-- Set True if the record type scope Rec has been pushed on the scope
-- stack. Needed for the analysis of delayed aspects specified to the
-- components of Rec.
Sized_Component_Total_RM_Size : Uint := Uint_0;
-- Accumulates total RM_Size values of all sized components. Used
-- for processing of Implicit_Packing.
SSO_ADC : Node_Id;
-- Scalar_Storage_Order attribute definition clause for the record
SSO_ADC_Component : Boolean := False;
-- Set True if we find at least one component whose type has a
-- Scalar_Storage_Order attribute definition clause.
Unplaced_Component : Boolean := False;
-- Set True if we find at least one component with no component
-- clause (used to warn about useless Pack pragmas).
function Check_Allocator (N : Node_Id) return Node_Id;
-- If N is an allocator, possibly wrapped in one or more level of
-- qualified expression(s), return the inner allocator node, else
@ -4419,10 +4419,12 @@ package body Freeze is
-- packing is required for it, as we are sure in this case that
-- the back end cannot do the expected layout without packing.
and then ((All_Elem_Components
and then RM_Size (Rec) < Elem_Component_Total_Esize)
or else (not All_Elem_Components
and then not All_Storage_Unit_Components))
and then
((All_Elem_Components
and then RM_Size (Rec) < Elem_Component_Total_Esize)
or else
(not All_Elem_Components
and then not All_Storage_Unit_Components))
-- And the total RM size cannot be greater than the specified size
-- since otherwise packing will not get us where we have to be.
@ -5461,20 +5463,21 @@ package body Freeze is
-- the RM_Size of the component type.
if RM_Size (E) = Num_Elmts * Rsiz then
-- For implicit packing mode, just set the component
-- size and Freeze_Array_Type will do the rest.
if Implicit_Packing then
Set_Component_Size (Btyp, Rsiz);
-- Otherwise give an error message
-- Otherwise give an error message
else
Error_Msg_NE
("size given for& too small", SZ, E);
Error_Msg_N -- CODEFIX
("\use explicit pragma Pack "
& "or use pragma Implicit_Packing", SZ);
("\use explicit pragma Pack or use pragma "
& "Implicit_Packing", SZ);
end if;
end if;
end if;

7
gcc/ada/g-forstr.ads
View File

@ -144,7 +144,12 @@ package GNAT.Formatted_String is
use Ada;
type Formatted_String (<>) is private;
-- A format string as defined for printf routine
-- A format string as defined for printf routine. This string is the
-- actual format for all the parameters added with the "&" routines below.
-- Note that a Formatted_String object can't be reused as it serves as
-- recipient for the final result. That is, each use of "&" will build
-- incrementally the final result string which can be retrieved with
-- the "-" routine below.
Format_Error : exception;
-- Raised for every mismatch between the parameter and the expected format

2
gcc/ada/ghost.adb
View File

@ -1177,6 +1177,8 @@ package body Ghost is
-- A freeze node for an ignored ghost entity must be pruned as
-- well, to prevent meaningless references in the back end.
-- ??? the freeze node itself should be ignored ghost
elsif Nkind (N) = N_Freeze_Entity
and then Is_Ignored_Ghost_Entity (Entity (N))
then

25
gcc/ada/sem_ch12.adb
View File

@ -6695,17 +6695,23 @@ package body Sem_Ch12 is
elsif Nkind (Gen_Id) = N_Expanded_Name then
-- Entity already present, analyze prefix, whose meaning may be
-- an instance in the current context. If it is an instance of
-- a relative within another, the proper parent may still have
-- to be installed, if they are not of the same generation.
-- Entity already present, analyze prefix, whose meaning may be an
-- instance in the current context. If it is an instance of a
-- relative within another, the proper parent may still have to be
-- installed, if they are not of the same generation.
Analyze (Prefix (Gen_Id));
-- In the unlikely case that a local declaration hides the name
-- of the parent package, locate it on the homonym chain. If the
-- context is an instance of the parent, the renaming entity is
-- flagged as such.
-- Prevent cascaded errors
if Etype (Prefix (Gen_Id)) = Any_Type then
return;
end if;
-- In the unlikely case that a local declaration hides the name of
-- the parent package, locate it on the homonym chain. If the context
-- is an instance of the parent, the renaming entity is flagged as
-- such.
Inst_Par := Entity (Prefix (Gen_Id));
while Present (Inst_Par)
@ -10681,10 +10687,11 @@ package body Sem_Ch12 is
-- An effectively volatile object cannot be used as an actual in a
-- generic instantiation (SPARK RM 7.1.3(7)). The following check is
-- relevant only when SPARK_Mode is on as it is not a standard Ada
-- legality rule.
-- legality rule, and also verifies that the actual is an object.
if SPARK_Mode = On
and then Present (Actual)
and then Is_Object_Reference (Actual)
and then Is_Effectively_Volatile_Object (Actual)
then
Error_Msg_N

3
gcc/ada/sem_ch13.adb
View File

@ -12049,7 +12049,7 @@ package body Sem_Ch13 is
Subp_Decl :=
Make_Subprogram_Renaming_Declaration (Loc,
Specification => Build_Spec,
Name => New_Occurrence_Of (Subp, Loc));
Name => New_Occurrence_Of (Subp, Loc));
if Defer_Declaration then
Set_TSS (Base_Type (Ent), Subp_Id);
@ -12057,7 +12057,6 @@ package body Sem_Ch13 is
else
if From_Aspect_Specification (N) then
Append_Freeze_Action (Ent, Subp_Decl);
else
Insert_Action (N, Subp_Decl);
end if;

21
gcc/ada/sem_ch7.adb
View File

@ -1392,7 +1392,7 @@ package body Sem_Ch7 is
-- If one of the non-generic parents is itself on the scope
-- stack, do not install its private declarations: they are
-- installed in due time when the private part of that parent
-- is analyzed. This is delicate ???
-- is analyzed.
else
while Present (Inst_Par)
@ -1400,11 +1400,20 @@ package body Sem_Ch7 is
and then (not In_Open_Scopes (Inst_Par)
or else not In_Private_Part (Inst_Par))
loop
Install_Private_Declarations (Inst_Par);
Set_Use (Private_Declarations
(Specification
(Unit_Declaration_Node (Inst_Par))));
Inst_Par := Scope (Inst_Par);
if Nkind (Inst_Node) = N_Formal_Package_Declaration
or else
not Is_Ancestor_Package
(Inst_Par, Cunit_Entity (Current_Sem_Unit))
then
Install_Private_Declarations (Inst_Par);
Set_Use
(Private_Declarations
(Specification
(Unit_Declaration_Node (Inst_Par))));
Inst_Par := Scope (Inst_Par);
else
exit;
end if;
end loop;
exit;