+2017-05-02 Justin Squirek <squirek@adacore.com>
+
+ * sem_ch4.adb (Analyze_Case_Expression): Add check for valid
+ alternative expression.
+ * sem_res.adb (Resolve_Case_Expression): Ditto.
+
+2017-05-02 Ed Schonberg <schonberg@adacore.com>
+
+ * exp_disp.adb (Set_All_DT_Position, In_Predef_Prim_DT):
+ Refine predicate for the case where the primitive operation
+ is a renaming of equality. An overriding operation that is
+ a user-defined renaming of predefined equality inherits its
+ slot from the overridden operation. Otherwise it is treated
+ as a predefined op and occupies the same predefined slot as
+ equality. A call to it is transformed into a call to its alias,
+ which is the predefined equality. A dispatching call thus uses
+ the proper slot if operation is further inherited and called
+ with class-wide arguments.
+
+2017-05-02 Justin Squirek <squirek@adacore.com>
+
+ * errout.adb (Set_Msg_Text): Add a case to switch the message
+ type when the character '[' is detected signifying a warning
+ about a run-time exception.
+ * opt.ads Add a new Warning_Mode value for new switch
+ * switch-b.adb (Scan_Binder_Switches): Add case for the binder
+ to handle new warning mode
+ * usage.adb (Usage): Add usage entry for -gnatwE
+ * warnsw.adb (Set_Warning_Switch): Add case for the new switch
+
+2017-05-02 Ed Schonberg <schonberg@adacore.com>
+
+ * sem_prag.adb (Process_Conversion): Reject an intrinsic operator
+ declaration that operates on some fixed point type.
+
+2017-05-02 Justin Squirek <squirek@adacore.com>
+
+ * a-crbtgo.adb, s-taasde.adb: Remove unused use-type clauses.
+
2017-05-02 Hristian Kirtchev <kirtchev@adacore.com>
* sem_ch6.adb (Analyze_Null_Procedure): Revert previous change.
-- --
-- B o d y --
-- --
--- Copyright (C) 2004-2016, Free Software Foundation, Inc. --
+-- Copyright (C) 2004-2017, 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- --
--------------------
procedure Generic_Adjust (Tree : in out Tree_Type) is
- N : constant Count_Type := Tree.Length;
+ N : constant Count_Type := Tree.Length;
Root : constant Node_Access := Tree.Root;
- use type Helpers.Tamper_Counts;
+
begin
-- If the counts are nonzero, execution is technically erroneous, but
-- it seems friendly to allow things like concurrent "=" on shared
-- '[' (will be/would have been raised at run time)
when '[' =>
+
+ -- Switch the message from a warning to an error if the flag
+ -- -gnatwE is specified to treat run-time exception warnings
+ -- as errors.
+
+ if Is_Warning_Msg
+ and then Warning_Mode = Treat_Run_Time_As_Error
+ then
+ Is_Warning_Msg := False;
+ end if;
+
if Is_Warning_Msg then
Set_Msg_Str ("will be raised at run time");
else
------------------------
function In_Predef_Prims_DT (Prim : Entity_Id) return Boolean is
- E : Entity_Id;
-
begin
-- Predefined primitives
if Chars (Ultimate_Alias (Prim)) /= Name_Op_Eq then
return True;
- -- User-defined renamings of predefined equality have their own
- -- slot in the primary dispatch table
+ -- An overriding operation that is a user-defined renaming of
+ -- predefined equality inherits its slot from the overridden
+ -- operation. Otherwise it is treated as a predefined op and
+ -- occupies the same predefined slot as equality. A call to it is
+ -- transformed into a call to its alias, which is the predefined
+ -- equality op. A dispatching call thus uses the proper slot if
+ -- operation is further inherited and called with class-wide
+ -- arguments.
else
- E := Prim;
- while Present (Alias (E)) loop
- if Comes_From_Source (E) then
- return False;
- end if;
-
- E := Alias (E);
- end loop;
-
- return not Comes_From_Source (E);
+ return
+ not Comes_From_Source (Prim)
+ or else No (Overridden_Operation (Prim));
end if;
-- User-defined primitives
-- or where no warning has been suppressed by the use of the pragma.
-- Modified by use of -gnatw.w/.W.
- type Warning_Mode_Type is (Suppress, Normal, Treat_As_Error);
+ type Warning_Mode_Type is
+ (Suppress, Normal, Treat_As_Error, Treat_Run_Time_As_Error);
Warning_Mode : Warning_Mode_Type := Normal;
-- GNAT, GNATBIND
-- Controls treatment of warning messages. If set to Suppress, warning
-- messages are not generated at all. In Normal mode, they are generated
-- but do not count as errors. In Treat_As_Error mode, warning messages are
- -- generated and are treated as errors. Note that Warning_Mode = Suppress
- -- causes pragma Warnings to be ignored (except for legality checks),
- -- unless we are in GNATprove_Mode, which requires pragma Warnings to
- -- be stored for the formal verification backend.
+ -- generated and are treated as errors. In Treat_Run_Time_As_Error, warning
+ -- messages regarding errors raised at run time are treated as errors. Note
+ -- that Warning_Mode = Suppress causes pragma Warnings to be ignored
+ -- (except for legality checks), unless we are in GNATprove_Mode, which
+ -- requires pragma Warnings to be stored for the formal verification
+ -- backend.
Warnings_As_Errors_Count : Natural;
-- GNAT
-- --
-- B o d y --
-- --
--- Copyright (C) 1998-2014, Free Software Foundation, Inc. --
+-- Copyright (C) 1998-2017, Free Software Foundation, Inc. --
-- --
-- GNARL 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- --
Self_Id : constant Task_Id := STPO.Self;
Q : Delay_Block_Access;
- use type ST.Task_Id;
- -- for visibility of operator "="
-
begin
pragma Debug (Debug.Trace (Self_Id, "Async_Delay", 'P'));
pragma Assert (Self_Id.Deferral_Level = 1,
Alt := First (Alternatives (N));
while Present (Alt) loop
+ if Error_Posted (Expression (Alt)) then
+ return;
+ end if;
+
Analyze (Expression (Alt));
if No (FirstX) and then Etype (Expression (Alt)) /= Any_Type then
New_N :=
Make_Function_Call (Loc,
- Name => Make_Explicit_Dereference (Loc, P),
- Parameter_Associations => New_List);
+ Name => Make_Explicit_Dereference (Loc, P),
+ Parameter_Associations => New_List);
-- If the prefix is overloaded, remove operations that have formals,
-- we know that this is a parameterless call.
Check_Error_Detected;
return;
end if;
+
Then_Expr := Next (Condition);
if No (Then_Expr) then
Check_Error_Detected;
return;
end if;
+
Else_Expr := Next (Then_Expr);
if Comes_From_Source (N) then
-- given entity, not its homonyms.
if From_Aspect_Specification (N) then
+ if C = Convention_Intrinsic
+ and then Nkind (Ent) = N_Defining_Operator_Symbol
+ then
+ if Is_Fixed_Point_Type (Etype (Ent))
+ or else Is_Fixed_Point_Type (Etype (First_Entity (Ent)))
+ or else Is_Fixed_Point_Type (Etype (Last_Entity (Ent)))
+ then
+ Error_Msg_N
+ ("no intrinsic operator available for this fixed-point "
+ & "operation", N);
+ Error_Msg_N
+ ("\use expression functions with the desired "
+ & "conversions made explicit", N);
+ end if;
+ end if;
+
return;
end if;
Alt := First (Alternatives (N));
while Present (Alt) loop
Alt_Expr := Expression (Alt);
+
+ if Error_Posted (Alt_Expr) then
+ return;
+ end if;
+
Resolve (Alt_Expr, Typ);
Alt_Typ := Etype (Alt_Expr);
if No (Condition) then
return;
end if;
+
Then_Expr := Next (Condition);
if No (Then_Expr) then
return;
end if;
+
Else_Expr := Next (Then_Expr);
Resolve (Condition, Any_Boolean);
-- a constraint check. The same is done for the else part below, again
-- comparing subtypes rather than base types.
- if Is_Scalar_Type (Then_Typ)
- and then Then_Typ /= Typ
- then
+ if Is_Scalar_Type (Then_Typ) and then Then_Typ /= Typ then
Rewrite (Then_Expr, Convert_To (Typ, Then_Expr));
Analyze_And_Resolve (Then_Expr, Typ);
end if;
-- --
-- B o d y --
-- --
--- Copyright (C) 2001-2016, Free Software Foundation, Inc. --
+-- Copyright (C) 2001-2017, 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- --
when 'e' =>
Warning_Mode := Treat_As_Error;
+ when 'E' =>
+ Warning_Mode := Treat_Run_Time_As_Error;
+
when 's' =>
Warning_Mode := Suppress;
Write_Line (" e treat all warnings (but not info) as errors");
Write_Line (" .e turn on every optional info/warning " &
"(no exceptions)");
+ Write_Line (" E treat all run time warnings as errors");
Write_Line (" f+ turn on warnings for unreferenced formal");
Write_Line (" F* turn off warnings for unreferenced formal");
Write_Line (" .f turn on warnings for suspicious Subp'Access");
when 'e' =>
Warning_Mode := Treat_As_Error;
+ when 'E' =>
+ Warning_Mode := Treat_Run_Time_As_Error;
+
when 'f' =>
Check_Unreferenced_Formals := True;