Commit b55993b3 by Arnaud Charlet

[multiple changes]

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.

From-SVN: r247478
parent a6354842
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.
......
......@@ -6,7 +6,7 @@
-- --
-- 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- --
......@@ -510,9 +510,9 @@ package body Ada.Containers.Red_Black_Trees.Generic_Operations is
--------------------
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
......
......@@ -3097,6 +3097,17 @@ package body Errout is
-- '[' (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
......
......@@ -7430,8 +7430,6 @@ package body Exp_Disp is
------------------------
function In_Predef_Prims_DT (Prim : Entity_Id) return Boolean is
E : Entity_Id;
begin
-- Predefined primitives
......@@ -7446,20 +7444,19 @@ package body Exp_Disp is
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
......
......@@ -1860,16 +1860,19 @@ package Opt is
-- 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
......
......@@ -6,7 +6,7 @@
-- --
-- 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- --
......@@ -203,9 +203,6 @@ package body System.Tasking.Async_Delays is
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,
......
......@@ -1548,6 +1548,10 @@ package body Sem_Ch4 is
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
......@@ -2120,8 +2124,8 @@ package body Sem_Ch4 is
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.
......@@ -2226,12 +2230,14 @@ package body Sem_Ch4 is
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
......
......@@ -7732,6 +7732,22 @@ package body Sem_Prag is
-- 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;
......@@ -6712,6 +6712,11 @@ package body Sem_Res is
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);
......@@ -8252,11 +8257,13 @@ package body Sem_Res is
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);
......@@ -8268,9 +8275,7 @@ package body Sem_Res is
-- 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;
......
......@@ -6,7 +6,7 @@
-- --
-- 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- --
......@@ -490,6 +490,9 @@ package body Switch.B is
when 'e' =>
Warning_Mode := Treat_As_Error;
when 'E' =>
Warning_Mode := Treat_Run_Time_As_Error;
when 's' =>
Warning_Mode := Suppress;
......
......@@ -488,6 +488,7 @@ begin
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");
......
......@@ -532,6 +532,9 @@ package body Warnsw is
when 'e' =>
Warning_Mode := Treat_As_Error;
when 'E' =>
Warning_Mode := Treat_Run_Time_As_Error;
when 'f' =>
Check_Unreferenced_Formals := True;
......
Markdown is supported
0% or
You are about to add 0 people to the discussion. Proceed with caution.
Finish editing this message first!
Please register or to comment