[multiple changes]
2014-08-01 Tristan Gingold <gingold@adacore.com> * sem_ch9.adb (Analyze_Task_Type_Declaration): Move code from ... * exp_ch9.adb (Make_Task_Create_Call): ... here. 2014-08-01 Vincent Celier <celier@adacore.com> * gnat1drv.adb: Do not try to get the target parameters when invoked with -gnats. 2014-08-01 Hristian Kirtchev <kirtchev@adacore.com> * exp_ch7.adb (Find_Last_Init): Nothing to do for an object declaration subject to No_Initialization. 2014-08-01 Ed Schonberg <schonberg@adacore.com> * sem_aggr.adb (Resolve_Array_Aggregate): Reject choice that is a subtype with dynamic predicates, or a non-static subtype with predicates. * sem_ch3.adb (Analyze_Number_Declaration): Reject qualified expression if subtype has a dynamic predicate. (Constrain_Index): Reject subtype indication if subtype mark has predicates. (Inerit_Predicate_Flags): Inherit Has_Predicates as well. (Make_Index): If index is a subtype indication, itype inhereits predicate flags for subsequent testing. * sem_ch5.adb (Analyze_Loop_Parameter_Specification): New procedure Check_Predicate_Use, to reject illegal uses of domains of iteration that have dynamic predicates. * sem_res.adb (Resolve_Slice): Reject slices given by a subtype indication to which a predicate applies. * sem_util.adb (Bad_Predicated_Subtype_Use): Add guard to prevent cascaded errors when subtype is invalid. From-SVN: r213450
This commit is contained in:
Arnaud Charlet
parent
73999267a3
commit
24de083ff5
@ -1,3 +1,38 @@
|
||||
2014-08-01 Tristan Gingold <gingold@adacore.com>
|
||||
|
||||
* sem_ch9.adb (Analyze_Task_Type_Declaration): Move code from ...
|
||||
* exp_ch9.adb (Make_Task_Create_Call): ... here.
|
||||
|
||||
2014-08-01 Vincent Celier <celier@adacore.com>
|
||||
|
||||
* gnat1drv.adb: Do not try to get the target parameters when
|
||||
invoked with -gnats.
|
||||
|
||||
2014-08-01 Hristian Kirtchev <kirtchev@adacore.com>
|
||||
|
||||
* exp_ch7.adb (Find_Last_Init): Nothing to do for an object
|
||||
declaration subject to No_Initialization.
|
||||
|
||||
2014-08-01 Ed Schonberg <schonberg@adacore.com>
|
||||
|
||||
* sem_aggr.adb (Resolve_Array_Aggregate): Reject choice that
|
||||
is a subtype with dynamic predicates, or a non-static subtype
|
||||
with predicates.
|
||||
* sem_ch3.adb (Analyze_Number_Declaration): Reject qualified
|
||||
expression if subtype has a dynamic predicate.
|
||||
(Constrain_Index): Reject subtype indication if subtype mark
|
||||
has predicates.
|
||||
(Inerit_Predicate_Flags): Inherit Has_Predicates as well.
|
||||
(Make_Index): If index is a subtype indication, itype inhereits
|
||||
predicate flags for subsequent testing.
|
||||
* sem_ch5.adb (Analyze_Loop_Parameter_Specification): New
|
||||
procedure Check_Predicate_Use, to reject illegal uses of domains
|
||||
of iteration that have dynamic predicates.
|
||||
* sem_res.adb (Resolve_Slice): Reject slices given by a subtype
|
||||
indication to which a predicate applies.
|
||||
* sem_util.adb (Bad_Predicated_Subtype_Use): Add guard to
|
||||
prevent cascaded errors when subtype is invalid.
|
||||
|
||||
2014-08-01 Robert Dewar <dewar@adacore.com>
|
||||
|
||||
* sem_ch10.adb: Minor reformatting.
|
||||
|
||||
@ -2449,6 +2449,15 @@ package body Exp_Ch7 is
|
||||
Next (Stmt);
|
||||
end loop;
|
||||
|
||||
-- Nothing to do for an object with supporessed initialization.
|
||||
-- Note that this check is not performed at the beginning of the
|
||||
-- routine because a declaration marked with No_Initialization
|
||||
-- may still be initialized by a build-in-place call (the case
|
||||
-- above).
|
||||
|
||||
elsif No_Initialization (Decl) then
|
||||
return;
|
||||
|
||||
-- In all other cases the initialization calls follow the related
|
||||
-- object. The general structure of object initialization built by
|
||||
-- routine Default_Initialize_Object is as follows:
|
||||
|
||||
@ -14013,20 +14013,6 @@ package body Exp_Ch9 is
|
||||
Ttyp := Corresponding_Concurrent_Type (Task_Rec);
|
||||
Tnam := Chars (Ttyp);
|
||||
|
||||
-- The sequential partition elaboration policy is supported only in the
|
||||
-- restricted profile.
|
||||
|
||||
-- This test should be in sem_ch9, not here ???
|
||||
|
||||
if Partition_Elaboration_Policy = 'S'
|
||||
and then not Restricted_Profile
|
||||
then
|
||||
Error_Msg_N
|
||||
("sequential elaboration supported only in restricted profile",
|
||||
Task_Rec);
|
||||
return Make_Null_Statement (Loc);
|
||||
end if;
|
||||
|
||||
-- Get task declaration. In the case of a task type declaration, this is
|
||||
-- simply the parent of the task type entity. In the single task
|
||||
-- declaration, this parent will be the implicit type, and we can find
|
||||
|
||||
@ -863,53 +863,65 @@ begin
|
||||
|
||||
Opt.Compilation_Time := System.OS_Lib.Current_Time_String;
|
||||
|
||||
-- Acquire target parameters from system.ads (source of package System)
|
||||
-- Get the target parameters only when -gnats is not used, to avoid
|
||||
-- failing when there is no default runtime.
|
||||
|
||||
Targparm_Acquire : declare
|
||||
use Sinput;
|
||||
if Operating_Mode /= Check_Syntax then
|
||||
|
||||
S : Source_File_Index;
|
||||
N : File_Name_Type;
|
||||
-- Acquire target parameters from system.ads (package System source)
|
||||
-- System).
|
||||
|
||||
begin
|
||||
Name_Buffer (1 .. 10) := "system.ads";
|
||||
Name_Len := 10;
|
||||
N := Name_Find;
|
||||
S := Load_Source_File (N);
|
||||
Targparm_Acquire : declare
|
||||
use Sinput;
|
||||
|
||||
if S = No_Source_File then
|
||||
Write_Line
|
||||
("fatal error, run-time library not installed correctly");
|
||||
Write_Line ("cannot locate file system.ads");
|
||||
raise Unrecoverable_Error;
|
||||
S : Source_File_Index;
|
||||
N : File_Name_Type;
|
||||
|
||||
-- Remember source index of system.ads (which was read successfully)
|
||||
begin
|
||||
Name_Buffer (1 .. 10) := "system.ads";
|
||||
Name_Len := 10;
|
||||
N := Name_Find;
|
||||
S := Load_Source_File (N);
|
||||
|
||||
else
|
||||
System_Source_File_Index := S;
|
||||
end if;
|
||||
-- Failed to read system.ads, fatal error
|
||||
|
||||
Targparm.Get_Target_Parameters
|
||||
(System_Text => Source_Text (S),
|
||||
Source_First => Source_First (S),
|
||||
Source_Last => Source_Last (S),
|
||||
Make_Id => Tbuild.Make_Id'Access,
|
||||
Make_SC => Tbuild.Make_SC'Access,
|
||||
Set_RND => Tbuild.Set_RND'Access);
|
||||
if S = No_Source_File then
|
||||
Write_Line
|
||||
("fatal error, run-time library not installed correctly");
|
||||
Write_Line ("cannot locate file system.ads");
|
||||
raise Unrecoverable_Error;
|
||||
|
||||
-- Acquire configuration pragma information from Targparm
|
||||
-- Read system.ads successfully, remember its source index
|
||||
|
||||
Restrict.Restrictions := Targparm.Restrictions_On_Target;
|
||||
end Targparm_Acquire;
|
||||
else
|
||||
System_Source_File_Index := S;
|
||||
end if;
|
||||
|
||||
Targparm.Get_Target_Parameters
|
||||
(System_Text => Source_Text (S),
|
||||
Source_First => Source_First (S),
|
||||
Source_Last => Source_Last (S),
|
||||
Make_Id => Tbuild.Make_Id'Access,
|
||||
Make_SC => Tbuild.Make_SC'Access,
|
||||
Set_RND => Tbuild.Set_RND'Access);
|
||||
|
||||
-- Acquire configuration pragma information from Targparm
|
||||
|
||||
Restrict.Restrictions := Targparm.Restrictions_On_Target;
|
||||
end Targparm_Acquire;
|
||||
end if;
|
||||
|
||||
-- Perform various adjustments and settings of global switches
|
||||
|
||||
Adjust_Global_Switches;
|
||||
|
||||
-- Output copyright notice if full list mode unless we have a list
|
||||
-- file, in which case we defer this so that it is output in the file
|
||||
-- file, in which case we defer this so that it is output in the file.
|
||||
|
||||
if (Verbose_Mode or else (Full_List and then Full_List_File_Name = null))
|
||||
|
||||
-- Debug flag gnatd7 suppresses this copyright notice
|
||||
|
||||
and then not Debug_Flag_7
|
||||
then
|
||||
Write_Eol;
|
||||
|
||||
@ -1727,6 +1727,15 @@ package body Sem_Aggr is
|
||||
if Is_Type (E) and then Has_Predicates (E) then
|
||||
Freeze_Before (N, E);
|
||||
|
||||
if Has_Dynamic_Predicate_Aspect (E) then
|
||||
Error_Msg_NE ("subtype& has dynamic predicate,"
|
||||
& "not allowed in aggregate choice", Choice, E);
|
||||
|
||||
elsif not Is_Static_Subtype (E) then
|
||||
Error_Msg_NE ("non-static subtype& has predicate,"
|
||||
& "not allowed in aggregate choice", Choice, E);
|
||||
end if;
|
||||
|
||||
-- If the subtype has a static predicate, replace the
|
||||
-- original choice with the list of individual values
|
||||
-- covered by the predicate.
|
||||
@ -1882,6 +1891,14 @@ package body Sem_Aggr is
|
||||
elsif Nkind (Choice) = N_Subtype_Indication then
|
||||
Resolve_Discrete_Subtype_Indication (Choice, Index_Base);
|
||||
|
||||
if Has_Dynamic_Predicate_Aspect
|
||||
(Entity (Subtype_Mark (Choice)))
|
||||
then
|
||||
Error_Msg_NE ("subtype& has dynamic predicate, "
|
||||
& "not allowed in aggregate choice",
|
||||
Choice, Entity (Subtype_Mark (Choice)));
|
||||
end if;
|
||||
|
||||
-- Does the subtype indication evaluation raise CE?
|
||||
|
||||
Get_Index_Bounds (Subtype_Mark (Choice), S_Low, S_High);
|
||||
|
||||
@ -2920,6 +2920,11 @@ package body Sem_Ch3 is
|
||||
|
||||
if not Is_Overloaded (E) then
|
||||
T := Etype (E);
|
||||
if Has_Dynamic_Predicate_Aspect (T) then
|
||||
Error_Msg_N
|
||||
("subtype has dynamic predicate, "
|
||||
& "not allowed in number declaration", N);
|
||||
end if;
|
||||
|
||||
else
|
||||
T := Any_Type;
|
||||
@ -12424,6 +12429,10 @@ package body Sem_Ch3 is
|
||||
-- The parser has verified that this is a discrete indication
|
||||
|
||||
Resolve_Discrete_Subtype_Indication (S, T);
|
||||
Bad_Predicated_Subtype_Use
|
||||
("subtype& has predicate, not allowed in index constraint",
|
||||
S, Entity (Subtype_Mark (S)));
|
||||
|
||||
R := Range_Expression (Constraint (S));
|
||||
|
||||
-- Capture values of bounds and generate temporaries for them if
|
||||
@ -16802,6 +16811,7 @@ package body Sem_Ch3 is
|
||||
|
||||
procedure Inherit_Predicate_Flags (Subt, Par : Entity_Id) is
|
||||
begin
|
||||
Set_Has_Predicates (Subt, Has_Predicates (Par));
|
||||
Set_Has_Static_Predicate_Aspect
|
||||
(Subt, Has_Static_Predicate_Aspect (Par));
|
||||
Set_Has_Dynamic_Predicate_Aspect
|
||||
@ -17419,6 +17429,10 @@ package body Sem_Ch3 is
|
||||
Set_Scalar_Range (Def_Id, R);
|
||||
Conditional_Delay (Def_Id, T);
|
||||
|
||||
if Nkind (N) = N_Subtype_Indication then
|
||||
Inherit_Predicate_Flags (Def_Id, Entity (Subtype_Mark (N)));
|
||||
end if;
|
||||
|
||||
-- In the subtype indication case, if the immediate parent of the
|
||||
-- new subtype is non-static, then the subtype we create is non-
|
||||
-- static, even if its bounds are static.
|
||||
|
||||
@ -2134,6 +2134,12 @@ package body Sem_Ch5 is
|
||||
-- to capture the bounds, so that the function result can be finalized
|
||||
-- in timely fashion.
|
||||
|
||||
procedure Check_Predicate_Use (T : Entity_Id);
|
||||
-- Diagnose Attempt to iterate through non-static predicate. Note that
|
||||
-- a type with inherited predicates may have both static and dynamic
|
||||
-- forms. In this case it is not sufficent to check the static predicate
|
||||
-- function only, look for a dynamic predicate aspect as well.
|
||||
|
||||
function Has_Call_Using_Secondary_Stack (N : Node_Id) return Boolean;
|
||||
-- N is the node for an arbitrary construct. This function searches the
|
||||
-- construct N to see if any expressions within it contain function
|
||||
@ -2192,6 +2198,27 @@ package body Sem_Ch5 is
|
||||
end if;
|
||||
end Check_Controlled_Array_Attribute;
|
||||
|
||||
-------------------------
|
||||
-- Check_Predicate_Use --
|
||||
-------------------------
|
||||
|
||||
procedure Check_Predicate_Use (T : Entity_Id) is
|
||||
begin
|
||||
if Is_Discrete_Type (T)
|
||||
and then Has_Predicates (T)
|
||||
and then (not Has_Static_Predicate (T)
|
||||
or else Has_Dynamic_Predicate_Aspect (T))
|
||||
then
|
||||
Bad_Predicated_Subtype_Use
|
||||
("cannot use subtype& with non-static predicate for loop " &
|
||||
"iteration", Discrete_Subtype_Definition (N),
|
||||
T, Suggest_Static => True);
|
||||
|
||||
elsif Inside_A_Generic and then Is_Generic_Formal (T) then
|
||||
Set_No_Dynamic_Predicate_On_Actual (T);
|
||||
end if;
|
||||
end Check_Predicate_Use;
|
||||
|
||||
------------------------------------
|
||||
-- Has_Call_Using_Secondary_Stack --
|
||||
------------------------------------
|
||||
@ -2566,23 +2593,7 @@ package body Sem_Ch5 is
|
||||
Set_Etype (DS, Entity (DS));
|
||||
end if;
|
||||
|
||||
-- Attempt to iterate through non-static predicate. Note that a type
|
||||
-- with inherited predicates may have both static and dynamic forms.
|
||||
-- In this case it is not sufficent to check the static predicate
|
||||
-- function only, look for a dynamic predicate aspect as well.
|
||||
|
||||
if Is_Discrete_Type (Entity (DS))
|
||||
and then Has_Predicates (Entity (DS))
|
||||
and then (not Has_Static_Predicate (Entity (DS))
|
||||
or else Has_Dynamic_Predicate_Aspect (Entity (DS)))
|
||||
then
|
||||
Bad_Predicated_Subtype_Use
|
||||
("cannot use subtype& with non-static predicate for loop " &
|
||||
"iteration", DS, Entity (DS), Suggest_Static => True);
|
||||
|
||||
elsif Inside_A_Generic and then Is_Generic_Formal (Entity (DS)) then
|
||||
Set_No_Dynamic_Predicate_On_Actual (Entity (DS));
|
||||
end if;
|
||||
Check_Predicate_Use (Entity (DS));
|
||||
end if;
|
||||
|
||||
-- Error if not discrete type
|
||||
@ -2594,6 +2605,10 @@ package body Sem_Ch5 is
|
||||
|
||||
Check_Controlled_Array_Attribute (DS);
|
||||
|
||||
if Nkind (DS) = N_Subtype_Indication then
|
||||
Check_Predicate_Use (Entity (Subtype_Mark (DS)));
|
||||
end if;
|
||||
|
||||
Make_Index (DS, N, In_Iter_Schm => True);
|
||||
Set_Ekind (Id, E_Loop_Parameter);
|
||||
|
||||
|
||||
@ -2896,6 +2896,17 @@ package body Sem_Ch9 is
|
||||
begin
|
||||
Check_Restriction (No_Tasking, N);
|
||||
Tasking_Used := True;
|
||||
|
||||
-- The sequential partition elaboration policy is supported only in the
|
||||
-- restricted profile.
|
||||
|
||||
if Partition_Elaboration_Policy = 'S'
|
||||
and then not Restricted_Profile
|
||||
then
|
||||
Error_Msg_N
|
||||
("sequential elaboration supported only in restricted profile", N);
|
||||
end if;
|
||||
|
||||
T := Find_Type_Name (N);
|
||||
Generate_Definition (T);
|
||||
|
||||
|
||||
@ -9814,14 +9814,28 @@ package body Sem_Res is
|
||||
|
||||
-- Check bad use of type with predicates
|
||||
|
||||
if Has_Predicates (Etype (Drange)) then
|
||||
Bad_Predicated_Subtype_Use
|
||||
("subtype& has predicate, not allowed in slice",
|
||||
Drange, Etype (Drange));
|
||||
declare
|
||||
Subt : Entity_Id;
|
||||
|
||||
begin
|
||||
if Nkind (Drange) = N_Subtype_Indication
|
||||
and then Has_Predicates (Entity (Subtype_Mark (Drange)))
|
||||
then
|
||||
Subt := Entity (Subtype_Mark (Drange));
|
||||
|
||||
else
|
||||
Subt := Etype (Drange);
|
||||
end if;
|
||||
|
||||
if Has_Predicates (Subt) then
|
||||
Bad_Predicated_Subtype_Use
|
||||
("subtype& has predicate, not allowed in slice", Drange, Subt);
|
||||
end if;
|
||||
end;
|
||||
|
||||
-- Otherwise here is where we check suspicious indexes
|
||||
|
||||
elsif Nkind (Drange) = N_Range then
|
||||
if Nkind (Drange) = N_Range then
|
||||
Warn_On_Suspicious_Index (Name, Low_Bound (Drange));
|
||||
Warn_On_Suspicious_Index (Name, High_Bound (Drange));
|
||||
end if;
|
||||
|
||||
@ -782,7 +782,15 @@ package body Sem_Util is
|
||||
Suggest_Static : Boolean := False)
|
||||
is
|
||||
Gen : Entity_Id;
|
||||
|
||||
begin
|
||||
|
||||
-- Avoid cascaded errors
|
||||
|
||||
if Error_Posted (N) then
|
||||
return;
|
||||
end if;
|
||||
|
||||
if Inside_A_Generic then
|
||||
Gen := Current_Scope;
|
||||
while Present (Gen) and then Ekind (Gen) /= E_Generic_Package loop
|
||||
|
||||
Loading…
Reference in New Issue
Block a user