[multiple changes]
2011-08-03 Gary Dismukes <dismukes@adacore.com> * sem_aggr.adb (Analyze_Array_Aggregate): When checking the discrete choices of a named array aggregate, bail out when any choices are marked as Errors_Posted. 2011-08-03 Ed Schonberg <schonberg@adacore.com> * exp_ch13.adb (Expand_N_Freeze_Entity): cleanup determination of scope in which entity is frozen, to handle properly loop variables in iterators. 2011-08-03 Ed Schonberg <schonberg@adacore.com> * sem_res.adb (Set_String_Literal_Subtype): if the lower bound of the subtype is not static, compute the upper bound using attributes, to handle properly index types that are not integer types. 2011-08-03 Bob Duff <duff@adacore.com> * gnat_rm.texi, gnat_ugn.texi: Fix some dangling URLs. Update copyright notice. 2011-08-03 Ed Schonberg <schonberg@adacore.com> * sem_ch3.adb (Build_Discriminant_Constraints): Only use Original_Discriminant if within an instance. * sem_ch4.adb (Analyze_Selected_Component): Ditto. 2011-08-03 Thomas Quinot <quinot@adacore.com> * einfo.ads: Minor reformatting. 2011-08-03 Ed Schonberg <schonberg@adacore.com> * exp_disp.adb (Check_Premature_Freezing): diagnose the presence of a composite type with an unfrozen subcomponent, in the profile of a primitive operation. From-SVN: r177236
This commit is contained in:
Arnaud Charlet
parent
edc429ff61
commit
c0b1185020
|
|
@ -1,3 +1,42 @@
|
|||
2011-08-03 Gary Dismukes <dismukes@adacore.com>
|
||||
|
||||
* sem_aggr.adb (Analyze_Array_Aggregate): When checking the discrete
|
||||
choices of a named array aggregate, bail out when any choices are
|
||||
marked as Errors_Posted.
|
||||
|
||||
2011-08-03 Ed Schonberg <schonberg@adacore.com>
|
||||
|
||||
* exp_ch13.adb (Expand_N_Freeze_Entity): cleanup determination of scope
|
||||
in which entity is frozen, to handle properly loop variables in
|
||||
iterators.
|
||||
|
||||
2011-08-03 Ed Schonberg <schonberg@adacore.com>
|
||||
|
||||
* sem_res.adb (Set_String_Literal_Subtype): if the lower bound of the
|
||||
subtype is not static, compute the upper bound using attributes, to
|
||||
handle properly index types that are not integer types.
|
||||
|
||||
2011-08-03 Bob Duff <duff@adacore.com>
|
||||
|
||||
* gnat_rm.texi, gnat_ugn.texi: Fix some dangling URLs.
|
||||
Update copyright notice.
|
||||
|
||||
2011-08-03 Ed Schonberg <schonberg@adacore.com>
|
||||
|
||||
* sem_ch3.adb (Build_Discriminant_Constraints): Only use
|
||||
Original_Discriminant if within an instance.
|
||||
* sem_ch4.adb (Analyze_Selected_Component): Ditto.
|
||||
|
||||
2011-08-03 Thomas Quinot <quinot@adacore.com>
|
||||
|
||||
* einfo.ads: Minor reformatting.
|
||||
|
||||
2011-08-03 Ed Schonberg <schonberg@adacore.com>
|
||||
|
||||
* exp_disp.adb (Check_Premature_Freezing): diagnose the presence of a
|
||||
composite type with an unfrozen subcomponent, in the profile of a
|
||||
primitive operation.
|
||||
|
||||
2011-08-03 Robert Dewar <dewar@adacore.com>
|
||||
|
||||
* sem_util.ads, exp_aggr.adb, exp_ch3.adb: Minor reformatting.
|
||||
|
|
|
|||
|
|
@ -2426,11 +2426,11 @@ package Einfo is
|
|||
-- Thus this flag has no meaning to the back end.
|
||||
|
||||
-- Is_Limited_Composite (Flag106)
|
||||
-- Present in all entities. Set for composite types that have a
|
||||
-- limited component. Used to enforce the rule that operations on
|
||||
-- the composite type that depend on the full view of the component
|
||||
-- do not become visible until the immediate scope of the composite
|
||||
-- type itself (RM 7.3.1 (5)).
|
||||
-- Present in all entities. Set for composite types that have a limited
|
||||
-- component. Used to enforce the rule that operations on the composite
|
||||
-- type that depend on the full view of the component do not become
|
||||
-- visible until the immediate scope of the composite type itself
|
||||
-- (RM 7.3.1 (5)).
|
||||
|
||||
-- Is_Limited_Interface (Flag197)
|
||||
-- Present in record types and subtypes. True for interface types, if
|
||||
|
|
|
|||
|
|
@ -6,7 +6,7 @@
|
|||
-- --
|
||||
-- B o d y --
|
||||
-- --
|
||||
-- Copyright (C) 1992-2010, Free Software Foundation, Inc. --
|
||||
-- Copyright (C) 1992-2011, Free Software Foundation, Inc. --
|
||||
-- --
|
||||
-- GNAT is free software; you can redistribute it and/or modify it under --
|
||||
-- terms of the GNU General Public License as published by the Free Soft- --
|
||||
|
|
@ -43,7 +43,6 @@ with Sem_Eval; use Sem_Eval;
|
|||
with Sem_Util; use Sem_Util;
|
||||
with Sinfo; use Sinfo;
|
||||
with Snames; use Snames;
|
||||
with Stand; use Stand;
|
||||
with Tbuild; use Tbuild;
|
||||
with Uintp; use Uintp;
|
||||
with Validsw; use Validsw;
|
||||
|
|
@ -213,7 +212,6 @@ package body Exp_Ch13 is
|
|||
procedure Expand_N_Freeze_Entity (N : Node_Id) is
|
||||
E : constant Entity_Id := Entity (N);
|
||||
E_Scope : Entity_Id;
|
||||
S : Entity_Id;
|
||||
In_Other_Scope : Boolean;
|
||||
In_Outer_Scope : Boolean;
|
||||
Decl : Node_Id;
|
||||
|
|
@ -306,13 +304,18 @@ package body Exp_Ch13 is
|
|||
E_Scope := Corresponding_Spec (Unit_Declaration_Node (E_Scope));
|
||||
end if;
|
||||
|
||||
S := Current_Scope;
|
||||
while S /= Standard_Standard and then S /= E_Scope loop
|
||||
S := Scope (S);
|
||||
end loop;
|
||||
-- If the scope of the entity is in open scopes, it is the current one
|
||||
-- or an enclosing one, including a loop, a block, or a subprogram.
|
||||
|
||||
In_Other_Scope := not (S = E_Scope);
|
||||
In_Outer_Scope := (not In_Other_Scope) and then (S /= Current_Scope);
|
||||
if In_Open_Scopes (E_Scope) then
|
||||
In_Other_Scope := False;
|
||||
In_Outer_Scope := E_Scope /= Current_Scope;
|
||||
|
||||
-- Otherwise it is a local package or a different compilation unit.
|
||||
else
|
||||
In_Other_Scope := True;
|
||||
In_Outer_Scope := False;
|
||||
end if;
|
||||
|
||||
-- If the entity being frozen is defined in a scope that is not
|
||||
-- currently on the scope stack, we must establish the proper
|
||||
|
|
|
|||
|
|
@ -3764,7 +3764,10 @@ package body Exp_Disp is
|
|||
DT_Aggr : constant Elist_Id := New_Elmt_List;
|
||||
-- Entities marked with attribute Is_Dispatch_Table_Entity
|
||||
|
||||
procedure Check_Premature_Freezing (Subp : Entity_Id; Typ : Entity_Id);
|
||||
procedure Check_Premature_Freezing
|
||||
(Subp : Entity_Id;
|
||||
Tagged_Type : Entity_Id;
|
||||
Typ : Entity_Id);
|
||||
-- Verify that all non-tagged types in the profile of a subprogram
|
||||
-- are frozen at the point the subprogram is frozen. This enforces
|
||||
-- the rule on RM 13.14 (14) as modified by AI05-019. At the point a
|
||||
|
|
@ -3775,6 +3778,8 @@ package body Exp_Disp is
|
|||
-- Typical violation of the rule involves an object declaration that
|
||||
-- freezes a tagged type, when one of its primitive operations has a
|
||||
-- type in its profile whose full view has not been analyzed yet.
|
||||
-- More complex cases involve composite types that have one private
|
||||
-- unfrozen subcomponent.
|
||||
|
||||
procedure Export_DT (Typ : Entity_Id; DT : Entity_Id; Index : Nat := 0);
|
||||
-- Export the dispatch table DT of tagged type Typ. Required to generate
|
||||
|
|
@ -3814,10 +3819,15 @@ package body Exp_Disp is
|
|||
-- Check_Premature_Freezing --
|
||||
------------------------------
|
||||
|
||||
procedure Check_Premature_Freezing (Subp : Entity_Id; Typ : Entity_Id) is
|
||||
procedure Check_Premature_Freezing
|
||||
(Subp : Entity_Id;
|
||||
Tagged_Type : Entity_Id;
|
||||
Typ : Entity_Id)
|
||||
is
|
||||
Comp : Entity_Id;
|
||||
begin
|
||||
if Present (N)
|
||||
and then Is_Private_Type (Typ)
|
||||
and then Is_Private_Type (Typ)
|
||||
and then No (Full_View (Typ))
|
||||
and then not Is_Generic_Type (Typ)
|
||||
and then not Is_Tagged_Type (Typ)
|
||||
|
|
@ -3828,8 +3838,26 @@ package body Exp_Disp is
|
|||
("declaration must appear after completion of type &", N, Typ);
|
||||
Error_Msg_NE
|
||||
("\which is an untagged type in the profile of"
|
||||
& " primitive operation & declared#",
|
||||
N, Subp);
|
||||
& " primitive operation & declared#", N, Subp);
|
||||
|
||||
else
|
||||
Comp := Private_Component (Typ);
|
||||
|
||||
if not Is_Tagged_Type (Typ)
|
||||
and then Present (Comp)
|
||||
and then not Is_Frozen (Comp)
|
||||
then
|
||||
Error_Msg_Sloc := Sloc (Subp);
|
||||
Error_Msg_Node_2 := Subp;
|
||||
Error_Msg_Name_1 := Chars (Tagged_Type);
|
||||
Error_Msg_NE
|
||||
("declaration must appear after completion of type &",
|
||||
N, Comp);
|
||||
Error_Msg_NE
|
||||
("\which is a component of untagged type& in the profile of"
|
||||
& " primitive & of type % that is frozen by the declaration ",
|
||||
N, Typ);
|
||||
end if;
|
||||
end if;
|
||||
end Check_Premature_Freezing;
|
||||
|
||||
|
|
@ -4587,11 +4615,11 @@ package body Exp_Disp is
|
|||
begin
|
||||
F := First_Formal (Prim);
|
||||
while Present (F) loop
|
||||
Check_Premature_Freezing (Prim, Etype (F));
|
||||
Check_Premature_Freezing (Prim, Typ, Etype (F));
|
||||
Next_Formal (F);
|
||||
end loop;
|
||||
|
||||
Check_Premature_Freezing (Prim, Etype (Prim));
|
||||
Check_Premature_Freezing (Prim, Typ, Etype (Prim));
|
||||
end;
|
||||
|
||||
if Present (Frnodes) then
|
||||
|
|
|
|||
|
|
@ -4285,9 +4285,8 @@ Integrity Systems}, and has been approved by ISO/IEC/SC22/WG9 for inclusion in
|
|||
the next revision of the standard. The formal definition given by
|
||||
the Ada Rapporteur Group (ARG) can be found in two Ada Issues (AI-249 and
|
||||
AI-305) available at
|
||||
@url{http://www.ada-auth.org/cgi-bin/cvsweb.cgi/AIs/AI-00249.TXT} and
|
||||
@url{http://www.ada-auth.org/cgi-bin/cvsweb.cgi/AIs/AI-00305.TXT}
|
||||
respectively.
|
||||
@url{http://www.ada-auth.org/cgi-bin/cvsweb.cgi/ais/ai-00249.txt} and
|
||||
@url{http://www.ada-auth.org/cgi-bin/cvsweb.cgi/ais/ai-00305.txt}.
|
||||
|
||||
The above set is a superset of the restrictions provided by pragma
|
||||
@code{Profile (Restricted)}, it includes six additional restrictions
|
||||
|
|
|
|||
|
|
@ -7,7 +7,7 @@
|
|||
@c o
|
||||
@c G N A T _ U G N o
|
||||
@c o
|
||||
@c Copyright (C) 1992-2010, AdaCore o
|
||||
@c Copyright (C) 1992-2011, AdaCore o
|
||||
@c o
|
||||
@c oooooooooooooooooooooooooooooooooooooooooooooooooooooooooooooooooooooooooooo
|
||||
|
||||
|
|
|
|||
|
|
@ -1823,6 +1823,9 @@ package body Sem_Aggr is
|
|||
-- Used to keep track of the number of discrete choices in the
|
||||
-- current association.
|
||||
|
||||
Errors_Posted_On_Choices : Boolean := False;
|
||||
-- Keeps track of whether any choices have semantic errors
|
||||
|
||||
begin
|
||||
-- STEP 2 (A): Check discrete choices validity
|
||||
|
||||
|
|
@ -1867,6 +1870,14 @@ package body Sem_Aggr is
|
|||
Check_Unset_Reference (Choice);
|
||||
Check_Non_Static_Context (Choice);
|
||||
|
||||
-- If semantic errors were posted on the choice, then
|
||||
-- record that for possible early return from later
|
||||
-- processing (see handling of enumeration choices).
|
||||
|
||||
if Error_Posted (Choice) then
|
||||
Errors_Posted_On_Choices := True;
|
||||
end if;
|
||||
|
||||
-- Do not range check a choice. This check is redundant
|
||||
-- since this test is already done when we check that the
|
||||
-- bounds of the array aggregate are within range.
|
||||
|
|
@ -2144,13 +2155,12 @@ package body Sem_Aggr is
|
|||
and then Compile_Time_Known_Value (Choices_Low)
|
||||
and then Compile_Time_Known_Value (Choices_High)
|
||||
then
|
||||
-- If the bounds have semantic errors, do not attempt
|
||||
-- further resolution to prevent cascaded errors.
|
||||
-- If any of the expressions or range bounds in choices
|
||||
-- have semantic errors, then do not attempt further
|
||||
-- resolution, to prevent cascaded errors.
|
||||
|
||||
if Error_Posted (Choices_Low)
|
||||
or else Error_Posted (Choices_High)
|
||||
then
|
||||
return False;
|
||||
if Errors_Posted_On_Choices then
|
||||
return Failure;
|
||||
end if;
|
||||
|
||||
declare
|
||||
|
|
|
|||
|
|
@ -8298,7 +8298,9 @@ package body Sem_Ch3 is
|
|||
-- the point of instantiation, we want to find the discriminant
|
||||
-- that corresponds to D in Rec, i.e. X.
|
||||
|
||||
if Present (Original_Discriminant (Id)) then
|
||||
if Present (Original_Discriminant (Id))
|
||||
and then In_Instance
|
||||
then
|
||||
Discr := Find_Corresponding_Discriminant (Id, T);
|
||||
Found := True;
|
||||
|
||||
|
|
|
|||
|
|
@ -3754,6 +3754,7 @@ package body Sem_Ch4 is
|
|||
-- be done transitively, so note the new original discriminant.
|
||||
|
||||
if Nkind (Sel) = N_Identifier
|
||||
and then In_Instance
|
||||
and then Present (Original_Discriminant (Sel))
|
||||
then
|
||||
Comp := Find_Corresponding_Discriminant (Sel, Prefix_Type);
|
||||
|
|
|
|||
|
|
@ -9873,29 +9873,49 @@ package body Sem_Res is
|
|||
Set_String_Literal_Low_Bound (Subtype_Id, Low_Bound);
|
||||
|
||||
else
|
||||
Set_String_Literal_Low_Bound
|
||||
(Subtype_Id, Make_Integer_Literal (Loc, 1));
|
||||
Set_Etype (String_Literal_Low_Bound (Subtype_Id), Standard_Positive);
|
||||
|
||||
-- Build bona fide subtype for the string, and wrap it in an
|
||||
-- unchecked conversion, because the backend expects the
|
||||
-- String_Literal_Subtype to have a static lower bound.
|
||||
-- If the lower bound is not static we create a range for the string
|
||||
-- literal, using the index type and the known length of the literal.
|
||||
-- The index type is not necessarily Positive, so the upper bound is
|
||||
-- computed as T'Val (T'Pos (Low_Bound) + L - 1)
|
||||
|
||||
declare
|
||||
Index_List : constant List_Id := New_List;
|
||||
Index_Type : constant Entity_Id := Etype (First_Index (Typ));
|
||||
High_Bound : constant Node_Id :=
|
||||
Make_Op_Add (Loc,
|
||||
Left_Opnd => New_Copy_Tree (Low_Bound),
|
||||
Right_Opnd =>
|
||||
Make_Integer_Literal (Loc,
|
||||
String_Length (Strval (N)) - 1));
|
||||
Make_Attribute_Reference (Loc,
|
||||
Attribute_Name => Name_Val,
|
||||
Prefix => New_Occurrence_Of (Index_Type, Loc),
|
||||
Expressions =>
|
||||
New_List (
|
||||
Make_Op_Add (Loc,
|
||||
Left_Opnd =>
|
||||
Make_Attribute_Reference (Loc,
|
||||
Attribute_Name => Name_Pos,
|
||||
Prefix => New_Occurrence_Of (Index_Type, Loc),
|
||||
Expressions => New_List (New_Copy_Tree (Low_Bound))),
|
||||
Right_Opnd =>
|
||||
Make_Integer_Literal (Loc,
|
||||
String_Length (Strval (N)) - 1))));
|
||||
|
||||
Array_Subtype : Entity_Id;
|
||||
Index_Subtype : Entity_Id;
|
||||
Drange : Node_Id;
|
||||
Index : Node_Id;
|
||||
|
||||
begin
|
||||
Set_String_Literal_Low_Bound
|
||||
(Subtype_Id,
|
||||
Make_Attribute_Reference (Loc,
|
||||
Attribute_Name => Name_First,
|
||||
Prefix =>
|
||||
New_Occurrence_Of (Base_Type (Index_Type), Loc)));
|
||||
Set_Etype (String_Literal_Low_Bound (Subtype_Id), Index_Type);
|
||||
Analyze_And_Resolve (String_Literal_Low_Bound (Subtype_Id));
|
||||
|
||||
-- Build bona fide subtype for the string, and wrap it in an
|
||||
-- unchecked conversion, because the backend expects the
|
||||
-- String_Literal_Subtype to have a static lower bound.
|
||||
|
||||
Index_Subtype :=
|
||||
Create_Itype (Subtype_Kind (Ekind (Index_Type)), N);
|
||||
Drange := Make_Range (Loc, New_Copy_Tree (Low_Bound), High_Bound);
|
||||
|
|
|
|||
Loading…
Reference in New Issue