Commit 1f145d79 by Ed Schonberg Committed by Arnaud Charlet

sem_case.adb (Check_Choice_Set): Choose initial choice range below low bound of type...

2015-10-26  Ed Schonberg  <schonberg@adacore.com>

	* sem_case.adb (Check_Choice_Set): Choose initial choice range
	below low bound of type, to prevent spurious errors on case
	statements whose expressions have an integer subtype with a
	static predicate.
	* sem_util.ads: Fix typo.

From-SVN: r229332
parent 21d7ef70
2015-10-26 Ed Schonberg <schonberg@adacore.com> 2015-10-26 Ed Schonberg <schonberg@adacore.com>
* sem_case.adb (Check_Choice_Set): Choose initial choice range
below low bound of type, to prevent spurious errors on case
statements whose expressions have an integer subtype with a
static predicate.
* sem_util.ads: Fix typo.
2015-10-26 Ed Schonberg <schonberg@adacore.com>
* exp_ch4.adb (Expand_N_Case_Expression): In the scope of a * exp_ch4.adb (Expand_N_Case_Expression): In the scope of a
predicate function, delay the expansion of the expression only predicate function, delay the expansion of the expression only
if the target type has a specified Static_ Predicate aspect, if the target type has a specified Static_ Predicate aspect,
......
...@@ -6,7 +6,7 @@ ...@@ -6,7 +6,7 @@
-- -- -- --
-- B o d y -- -- B o d y --
-- -- -- --
-- Copyright (C) 1996-2014, Free Software Foundation, Inc. -- -- Copyright (C) 1996-2015, Free Software Foundation, Inc. --
-- -- -- --
-- GNAT is free software; you can redistribute it and/or modify it under -- -- 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- -- -- terms of the GNU General Public License as published by the Free Soft- --
...@@ -766,8 +766,14 @@ package body Sem_Case is ...@@ -766,8 +766,14 @@ package body Sem_Case is
if Has_Predicate then if Has_Predicate then
Pred := First (Static_Discrete_Predicate (Bounds_Type)); Pred := First (Static_Discrete_Predicate (Bounds_Type));
Prev_Lo := Uint_Minus_1;
Prev_Hi := Uint_Minus_1; -- Make initial value smaller than 'First of type, so that first
-- range comparison succeeds. This applies both to integer types
-- and to enumeration types.
Prev_Lo := Expr_Value (Type_Low_Bound (Bounds_Type)) - 1;
Prev_Hi := Prev_Lo;
Error := False; Error := False;
for Index in 1 .. Num_Choices loop for Index in 1 .. Num_Choices loop
......
...@@ -601,7 +601,7 @@ package Sem_Util is ...@@ -601,7 +601,7 @@ package Sem_Util is
(N : Node_Id; (N : Node_Id;
Formal : out Entity_Id; Formal : out Entity_Id;
Call : out Node_Id); Call : out Node_Id);
-- Determines if the node N is an actual parameter of a function of a -- Determines if the node N is an actual parameter of a function or a
-- procedure call. If so, then Formal points to the entity for the formal -- procedure call. If so, then Formal points to the entity for the formal
-- (Ekind is E_In_Parameter, E_Out_Parameter, or E_In_Out_Parameter) and -- (Ekind is E_In_Parameter, E_Out_Parameter, or E_In_Out_Parameter) and
-- Call is set to the node for the corresponding call. If the node N is not -- Call is set to the node for the corresponding call. If the node N is not
......
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