+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.
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
-- 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
-- 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.
-- 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;
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
-- 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
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)
-- 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
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);
else
if From_Aspect_Specification (N) then
Append_Freeze_Action (Ent, Subp_Decl);
-
else
Insert_Action (N, Subp_Decl);
end if;
-- 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)
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;
projects / gcc.git / commitdiff