+2015-05-26 Robert Dewar <dewar@adacore.com>
+
+ * sem_ch3.adb, sem_aux.adb, sem_aux.ads, exp_ch6.adb, sprint.adb:
+ Minor reformatting.
+
+2015-05-26 Gary Dismukes <dismukes@adacore.com>
+
+ * gnat1drv.adb, targparm.adb, targparm.ads, restrict.adb: Minor
+ reformatting and typo fixes in comments.
+
+2015-05-26 Ed Schonberg <schonberg@adacore.com>
+
+ * sem_ch7.adb (Swap_Private_Dependets): Set visibility of
+ the two views of a private dependent in two separate steps,
+ to ensure proper visibility in parent units analyzed for inlining.
+
2015-05-26 Yannick Moy <moy@adacore.com>
* sem_aux.adb, sem_aux.ads (Get_Low_Bound): Use Type_Low_Bound.
Pass_Caller_Acc : Boolean := False;
Res_Decl : Node_Id;
Result_Subt : Entity_Id;
- Definite : Boolean; -- True for definite function result subtype
+
+ Definite : Boolean;
+ -- True for definite function result subtype
begin
-- Step past qualification or unchecked conversion (the latter can occur
end if;
-- Call to get target parameters. Note that the actual interface
- -- routines in Tbuild here. They can't be in this procedure
- -- because of accessibility issues.
+ -- routines are in Tbuild. They can't be in this procedure because
+ -- of accessibility issues.
Targparm.Get_Target_Parameters
(System_Text => Source_Text (S),
No_Use_Of_Pragma : array (Pragma_Id) of Source_Ptr :=
(others => No_Location);
-- Source location of pragma No_Use_Of_Pragma for given pragma, a value
- -- of Sysstem_Location indicates occurrence in system.ads.
+ -- of System_Location indicates occurrence in system.ads.
No_Use_Of_Pragma_Warning : array (Pragma_Id) of Boolean :=
(others => False);
procedure Set_Restriction_No_Specification_Of_Aspect (A_Id : Aspect_Id) is
begin
+ No_Specification_Of_Aspect_Set := True;
No_Specification_Of_Aspects (A_Id) := System_Location;
No_Specification_Of_Aspect_Warning (A_Id) := False;
- No_Specification_Of_Aspect_Set := True;
end Set_Restriction_No_Specification_Of_Aspect;
-----------------------------------------
procedure Set_Restriction_No_Use_Of_Pragma (A_Id : Pragma_Id) is
begin
No_Use_Of_Pragma_Set := True;
- No_Use_Of_Pragma_Warning (A_Id) := False;
No_Use_Of_Pragma (A_Id) := System_Location;
+ No_Use_Of_Pragma_Warning (A_Id) := False;
end Set_Restriction_No_Use_Of_Pragma;
--------------------------------
-- if any discriminant has a default, they all do.
elsif Has_Discriminants (T) then
- return Present
- (Discriminant_Default_Value (First_Discriminant (T)));
+ return Present (Discriminant_Default_Value (First_Discriminant (T)));
else
return True;
-- Ent is any entity. Returns True if Ent is a type entity where the type
-- is required to be passed by reference, as defined in (RM 6.2(4-9)).
+ function Is_Definite_Subtype (T : Entity_Id) return Boolean;
+ -- T is a type entity. Returns True if T is a definite subtype.
+ -- Indefinite subtypes are unconstrained arrays, unconstrained
+ -- discriminated types without defaulted discriminants, class-wide types,
+ -- and types with unknown discriminants. Definite subtypes are all others
+ -- (elementary, constrained composites (including the case of records
+ -- without discriminants), and types with defaulted discriminants).
+
function Is_Derived_Type (Ent : Entity_Id) return Boolean;
-- Determines if the given entity Ent is a derived type. Result is always
-- false if argument is not a type.
-- used to set the visibility of generic formals of a generic package
-- declared with a box or with partial parameterization.
- function Is_Definite_Subtype (T : Entity_Id) return Boolean;
- -- T is a type entity. Returns True if T is a definite subtype.
- -- Indefinite subtypes are unconstrained arrays, unconstrained
- -- discriminated types without defaulted discriminants, class-wide types,
- -- and types with unknown discriminants. Definite subtypes are all others
- -- (elementary, constrained composites (including the case of records
- -- without discriminants), and types with defaulted discriminants).
-
function Is_Immutably_Limited_Type (Ent : Entity_Id) return Boolean;
-- Implements definition in Ada 2012 RM-7.5 (8.1/3). This differs from the
-- following predicate in that an untagged record with immutably limited
and then not Is_Constrained (T)
and then Has_Discriminants (T)
and then (Ada_Version < Ada_2005
- or else not Is_Definite_Subtype (T))
+ or else not Is_Definite_Subtype (T))
then
Set_Actual_Subtype (Id, Build_Default_Subtype (T, N));
end if;
Replace_Elmt (Priv_Elmt, Full_View (Priv));
-- Ensure that both views of the dependent private subtype are
- -- immediately visible if within some open scope.
+ -- immediately visible if within some open scope. Check full
+ -- view before exchanging views.
if In_Open_Scopes (Scope (Full_View (Priv))) then
Set_Is_Immediately_Visible (Priv);
- Set_Is_Immediately_Visible (Full_View (Priv));
end if;
Exchange_Declarations (Priv);
+ Set_Is_Immediately_Visible
+ (Priv, In_Open_Scopes (Scope (Priv)));
+
Set_Is_Potentially_Use_Visible
(Priv, Is_Potentially_Use_Visible (Node (Priv_Elmt)));
Sprint_Node (X);
Set_Sloc (X, Old_Sloc);
- -- Array subtypes.
- -- Preserve Sloc of index subtypes, as above.
+ -- Array subtypes
+
+ -- Preserve Sloc of index subtypes, as above
when E_Array_Subtype =>
Write_Header (False);
procedure Collect_Name;
-- Scan a name starting at System_Text (P), and put Name in Name_Buffer,
- -- with Name_Len being length, folded to lower case. On return P points
+ -- with Name_Len being length, folded to lower case. On return, P points
-- just past the last character (which should be a right paren).
------------------
type Set_NSA_Type is access procedure (Asp : Name_Id; OK : out Boolean);
-- Parameter type for Get_Target_Parameters that records a Restriction
- -- No_Specificaztion_Of_Aspect. Asp is the pragma name. OK is set True
+ -- No_Specification_Of_Aspect. Asp is the aspect name. OK is set True
-- if this is an OK aspect name, and False if it is not an aspect name.
type Set_NUA_Type is access procedure (Attr : Name_Id; OK : out Boolean);
-- Parameter type for Get_Target_Parameters that records a Restriction
- -- No_Use_Of_Attribute. Prag is the attribute name. OK is set True if
+ -- No_Use_Of_Attribute. Attr is the attribute name. OK is set True if
-- this is an OK attribute name, and False if it is not an attribute name.
type Set_NUP_Type is access procedure (Prag : Name_Id; OK : out Boolean);
Set_NUP : Set_NUP_Type := null);
-- Called at the start of execution to obtain target parameters from the
-- source of package System. The parameters provide the source text to be
- -- scanned (in System_Text (Source_First .. Source_Last)). if the three
+ -- scanned (in System_Text (Source_First .. Source_Last)). If the three
-- subprograms Make_Id, Make_SC, and Set_NOD are left at their default
-- value of null, Get_Target_Parameters will ignore pragma Restrictions
- -- No_Dependence lines, otherwise it will use these three subprograms to
- -- record them. Similarly if Set_NUP is left at its default value of null,
+ -- (No_Dependence) lines; otherwise it will use these three subprograms to
+ -- record them. Similarly, if Set_NUP is left at its default value of null,
-- then any occurrences of pragma Restrictions (No_Use_Of_Pragma => XXX)
- -- will be ignored, otherwise it will use this procedure to record the
+ -- will be ignored; otherwise it will use this procedure to record the
-- pragma. Similarly for the NSA and NUA cases.
procedure Get_Target_Parameters
projects / gcc.git / commitdiff