+2016-06-16 Gary Dismukes <dismukes@adacore.com>
+
+ * sem_util.adb: Minor typo fix.
+
+2016-06-16 Emmanuel Briot <briot@adacore.com>
+
+ * s-regpat.adb: Further fix for invalid index in GNAT.Regexp.
+
+2016-06-16 Eric Botcazou <ebotcazou@adacore.com>
+
+ * sem_ch13.adb (Validate_Address_Clauses): Use the same logic to
+ issue the warning on the offset for the size as for the alignment
+ and tweak the wording for the sake of consistency.
+
+2016-06-16 Ed Schonberg <schonberg@adacore.com>
+
+ * sem_prag.adb (Check_Class_Wide_COndition): New procedure,
+ subsidiary of Analyze_Pre_Post_ Condition_In_Decl_Part, to
+ check legality rules that follow from the revised semantics of
+ class-wide pre/postconditions described in AI12-0113.
+ (Build_Pragma_Check_Equivalent): Abstract subprogram declarations
+ must be included in list of overriding primitives of a derived
+ type.
+
2016-06-16 Ed Schonberg <schonberg@adacore.com>
* sem_util.adb (May_Be_Lvalue): An actual in an unexpanded
exit State_Machine when Input_Pos /= BOL_Pos;
when EOL =>
- exit State_Machine when Input_Pos <= Last_In_Data
- and then ((Self.Flags and Multiple_Lines) = 0
- or else Data (Input_Pos) /= ASCII.LF);
+ -- A combination of MEOL and SEOL
+ if (Self.Flags and Multiple_Lines) = 0 then
+ -- single line mode
+ exit State_Machine when Input_Pos <= Data'Last;
+ elsif Input_Pos <= Last_In_Data then
+ exit State_Machine when Data (Input_Pos) /= ASCII.LF;
+ else
+ exit State_Machine when Last_In_Data /= Data'Last;
+ end if;
when MEOL =>
- exit State_Machine when Input_Pos <= Last_In_Data
- and then Data (Input_Pos) /= ASCII.LF;
+ if Input_Pos <= Last_In_Data then
+ exit State_Machine when Data (Input_Pos) /= ASCII.LF;
+ else
+ exit State_Machine when Last_In_Data /= Data'Last;
+ end if;
when SEOL =>
- exit State_Machine when Input_Pos <= Last_In_Data;
+ -- If we have a character before Data'Last (even if
+ -- Last_In_Data stops before then), we can't have
+ -- the end of the line.
+ exit State_Machine when Input_Pos <= Data'Last;
when BOUND | NBOUND =>
Error_Msg_Uint_1 := Y_Size;
Error_Msg_NE ("\??size of & is ^", ACCR.N, ACCR.Y);
- if X_Offs /= Uint_0 then
+ if Y_Size >= X_Size then
Error_Msg_Uint_1 := X_Offs;
- Error_Msg_NE ("\??and offset of & is ^", ACCR.N, ACCR.X);
+ Error_Msg_NE ("\??but offset of & is ^", ACCR.N, ACCR.X);
end if;
-- Check for inadequate alignment, both of the base object
Disp_Typ : Entity_Id;
Restore_Scope : Boolean := False;
+ function Check_References (N : Node_Id) return Traverse_Result;
+ -- Check that the expression does not mention non-primitives of
+ -- the type, global objects of the type, or other illegalities
+ -- described and implied by AI12-0113.
+
+ ----------------------
+ -- Check_References --
+ ----------------------
+
+ function Check_References (N : Node_Id) return Traverse_Result is
+ begin
+ if Nkind (N) = N_Function_Call
+ and then Is_Entity_Name (Name (N))
+ then
+ declare
+ Func : constant Entity_Id := Entity (Name (N));
+ Form : Entity_Id;
+ begin
+
+ -- An operation of the type must be a primitive.
+
+ if No (Find_Dispatching_Type (Func)) then
+ Form := First_Formal (Func);
+ while Present (Form) loop
+ if Etype (Form) = Disp_Typ then
+ Error_Msg_NE ("operation in class-wide condition "
+ & "must be primitive of&", N, Disp_Typ);
+ end if;
+ Next_Formal (Form);
+ end loop;
+
+ -- A return object of the type is illegal as well.
+
+ if Etype (Func) = Disp_Typ
+ or else Etype (Func) = Class_Wide_Type (Disp_Typ)
+ then
+ Error_Msg_NE ("operation in class-wide condition "
+ & "must be primitive of&", N, Disp_Typ);
+ end if;
+ end if;
+ end;
+
+ elsif Is_Entity_Name (N)
+ and then
+ (Etype (N) = Disp_Typ
+ or else Etype (N) = Class_Wide_Type (Disp_Typ))
+ and then Ekind_In (Entity (N), E_Variable, E_Constant)
+ then
+ Error_Msg_NE
+ ("object in class-wide condition must be formal of type&",
+ N, Disp_Typ);
+
+ elsif Nkind (N) = N_Explicit_Dereference
+ and then (Etype (N) = Disp_Typ
+ or else Etype (N) = Class_Wide_Type (Disp_Typ))
+ and then (not Is_Entity_Name (Prefix (N))
+ or else not Is_Formal (Entity (Prefix (N))))
+ then
+ Error_Msg_NE ("operation in class-wide condition "
+ & "must be primitive of&", N, Disp_Typ);
+ end if;
+
+ return OK;
+ end Check_References;
+
+ procedure Check_Class_Wide_Condition is new
+ Traverse_Proc (Check_References);
+
-- Start of processing for Analyze_Pre_Post_Condition_In_Decl_Part
begin
("pragma % can only be specified for a primitive operation "
& "of a tagged type", N);
end if;
+
+ else
+ -- Remaining semantic checks require a full tree traversal.
+
+ Check_Class_Wide_Condition (Expr);
end if;
+
end if;
if Restore_Scope then
-- overridings between them.
while Present (Decl) loop
- if Nkind (Decl) = N_Subprogram_Declaration then
+ if Nkind_In (Decl,
+ N_Subprogram_Declaration, N_Abstract_Subprogram_Declaration)
+ then
Prim := Defining_Entity (Decl);
if Is_Subprogram (Prim)
pragma Assert (Has_Default_Init_Cond (Typ));
pragma Assert (Present (Prag));
- -- Nothing to do if the slec was not built. This occurs when the
+ -- Nothing to do if the spec was not built. This occurs when the
-- expression of the Default_Initial_Condition is missing or is
-- null.
projects / gcc.git / commitdiff