+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.
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:
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
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
+
+ else
+ System_Source_File_Index := S;
+ end if;
- Restrict.Restrictions := Targparm.Restrictions_On_Target;
- end Targparm_Acquire;
+ 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;
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.
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);
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;
-- 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
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
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.
-- 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
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 --
------------------------------------
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
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);
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);
-- 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;
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
projects / thirdparty / gcc.git / commitdiff
