+2009-04-07 Robert Dewar <dewar@adacore.com>
+
+ * checks.adb:
+ Remove Assume_Valid parameter from In_Subrange_Of calls
+
+ * sem_eval.adb:
+ (Is_Subrange_Of): Remove Assume_Valid parameter, not needed
+ (Is_In_Range): Remove incorrect use of Assume_Valid
+ (Is_Out_Of_Range): Remove incorrect use of Assume_Valid
+
+ * sem_eval.ads:
+ (Is_Subrange_Of): Remove Assume_Valid parameter, not needed
+ (Is_In_Range): Documentation cleanup
+ (Is_Out_Of_Range): Documentation cleanup
+
+ * gnat_rm.texi:
+ Add documentation for Assume_No_Invalid_Values pragma
+
+ * sem_ch12.adb: Minor reformatting
+
+ * sem_ch6.adb: (Check_Conformance): Avoid cascaded errors
+
+ * sem_prag.adb: Improve error message.
+
+ * gnatchop.adb, osint.ads, sinput.adb, sinput.ads, styleg.adb:
+ LF/CR no longer recognized as line terminator
+
+ * switch.ads: Minor documentation improvement
+
+ * vms_data.ads: Minor reformatting
+
2009-04-07 Robert Dewar <dewar@adacore.com>
* checks.adb (Determine_Range): Add Assume_Valid parameter
and then
Is_Discrete_Type (S_Typ) = Is_Discrete_Type (Target_Typ)
and then
- (In_Subrange_Of (S_Typ, Target_Typ,
- Assume_Valid => True,
- Fixed_Int => Fixed_Int)
+ (In_Subrange_Of (S_Typ, Target_Typ, Fixed_Int)
or else
Is_In_Range (Expr, Target_Typ,
Assume_Valid => True,
begin
if not Overflow_Checks_Suppressed (Target_Base)
and then not
- In_Subrange_Of (Expr_Type, Target_Base,
- Assume_Valid => True,
- Fixed_Int => Conv_OK)
+ In_Subrange_Of (Expr_Type, Target_Base, Fixed_Int => Conv_OK)
and then not Float_To_Int
then
Activate_Overflow_Check (N);
-- case the literal has already been labeled as having the subtype of
-- the target.
- if In_Subrange_Of (Source_Type, Target_Type, Assume_Valid => True)
+ if In_Subrange_Of (Source_Type, Target_Type)
and then not
(Nkind (N) = N_Integer_Literal
or else
-- The conversions will always work and need no check
- elsif In_Subrange_Of
- (Target_Type, Source_Base_Type, Assume_Valid => True)
- then
+ elsif In_Subrange_Of (Target_Type, Source_Base_Type) then
Insert_Action (N,
Make_Raise_Constraint_Error (Loc,
Condition =>
-- If that is the case, we can freely convert the source to the target,
-- and then test the target result against the bounds.
- elsif In_Subrange_Of
- (Source_Type, Target_Base_Type, Assume_Valid => True)
- then
+ elsif In_Subrange_Of (Source_Type, Target_Base_Type) then
-- We make a temporary to hold the value of the converted value
-- (converted to the base type), and then we will do the test against
-- range of the target type.
else
- if not In_Subrange_Of (S_Typ, T_Typ, Assume_Valid => True) then
+ if not In_Subrange_Of (S_Typ, T_Typ) then
Cond := Discrete_Expr_Cond (Ck_Node, T_Typ);
end if;
end if;
* Pragma Ada_2005::
* Pragma Annotate::
* Pragma Assert::
+* Pragma Assume_No_Invalid_Values::
* Pragma Ast_Entry::
* Pragma C_Pass_By_Copy::
* Pragma Check::
* Pragma Ada_2005::
* Pragma Annotate::
* Pragma Assert::
+* Pragma Assume_No_Invalid_Values::
* Pragma Ast_Entry::
* Pragma C_Pass_By_Copy::
* Pragma Check::
semantic correctness whether or not assertions are enabled, so turning
assertions on and off cannot affect the legality of a program.
+@node Pragma Assume_No_Invalid_Values
+@unnumberedsec Pragma Assume_No_Invalid_Values
+@findex Assume_No_Invalid_Values
+@cindex Invalid representations
+@cindex Invalid values
+@noindent
+Syntax:
+@smallexample @c ada
+pragma Assume_No_Invalid_Values (On | Off);
+@end smallexample
+
+@noindent
+This is a configuration pragma that controls the assumptions made by the
+compiler about the occurrence of invalid representations (invalid values)
+in the code.
+
+The default behavior (corresponding to an Off argument for this pragma), is
+to assume that values may in general be invalid unless the compiler can
+prove they are valid. Consider the following example:
+
+@smallexample @c ada
+V1 : Integer range 1 .. 10;
+V2 : Integer range 11 .. 20;
+...
+for J in V2 .. V1 loop
+ ...
+end loop;
+@end smallexample
+
+@noindent
+if V1 and V2 have valid values, then the loop is known at compile
+time not to execute since the lower bound must be greater than the
+upper bound. However in default mode, no such assumption is made,
+and the loop may execute. If @code{Assume_No_Invalid_Values (On)}
+is given, the compiler will assume that any occurrence of a variable
+other than in an explicit @code{'Valid} test always has a valid
+value, and the loop above will be optimized away.
+
+The use of @code{Assume_No_Invalid_Values (On)} is appropriate if
+you know your code is free of uninitialized variables and other
+possible sources of invalid representations, and may result in
+more efficient code.
+
@node Pragma Ast_Entry
@unnumberedsec Pragma Ast_Entry
@cindex OpenVMS
First := Ptr + 1;
end if;
- -- Recognize CR/LF or LF/CR combination
+ -- Recognize CR/LF
- if (Source (Ptr + 1) = ASCII.CR or Source (Ptr + 1) = ASCII.LF)
- and then Source (Ptr) /= Source (Ptr + 1)
- then
+ if Source (Ptr) = ASCII.CR and then Source (Ptr + 1) = ASCII.LF then
Last := First + 1;
end if;
--
-- CR
-- CR/LF
- -- LF/CR
-- LF
-- The source is terminated by an EOF (16#1A#) character, which is the last
Find_Type (Subtype_Mark (N));
T := Entity (Subtype_Mark (N));
- -- Verify that there is no redundant null exclusion.
+ -- Verify that there is no redundant null exclusion
if Null_Exclusion_Present (N) then
if not Is_Access_Type (T) then
Skip_Controlling_Formals : Boolean := False)
is
procedure Conformance_Error (Msg : String; N : Node_Id := New_Id);
- -- Post error message for conformance error on given node. Two messages
- -- are output. The first points to the previous declaration with a
- -- general "no conformance" message. The second is the detailed reason,
- -- supplied as Msg. The parameter N provide information for a possible
- -- & insertion in the message, and also provides the location for
- -- posting the message in the absence of a specified Err_Loc location.
+ -- Sets Conforms to False. If Errmsg is False, then that's all it does.
+ -- If Errmsg is True, then processing continues to post an error message
+ -- for conformance error on given node. Two messages are output. The
+ -- first message points to the previous declaration with a general "no
+ -- conformance" message. The second is the detailed reason, supplied as
+ -- Msg. The parameter N provide information for a possible & insertion
+ -- in the message, and also provides the location for posting the
+ -- message in the absence of a specified Err_Loc location.
-----------------------
-- Conformance_Error --
Get_Inst => Get_Inst)
and then not Access_Types_Match
then
- Conformance_Error ("\type of & does not match!", New_Formal);
+ -- Don't give error message if old type is Any_Type. This test
+ -- avoids some cascaded errors, e.g. in case of a bad spec.
+
+ if Errmsg and then Old_Formal_Base = Any_Type then
+ Conforms := False;
+ else
+ Conformance_Error ("\type of & does not match!", New_Formal);
+ end if;
+
return;
end if;
--------------------
function In_Subrange_Of
- (T1 : Entity_Id;
- T2 : Entity_Id;
- Assume_Valid : Boolean;
- Fixed_Int : Boolean := False) return Boolean
+ (T1 : Entity_Id;
+ T2 : Entity_Id;
+ Fixed_Int : Boolean := False) return Boolean
is
L1 : Node_Id;
H1 : Node_Id;
-- Check bounds to see if comparison possible at compile time
- if Compile_Time_Compare (L1, L2, Assume_Valid) in Compare_GE
+ if Compile_Time_Compare (L1, L2, Assume_Valid => True) in Compare_GE
and then
- Compile_Time_Compare (H1, H2, Assume_Valid) in Compare_LE
+ Compile_Time_Compare (H1, H2, Assume_Valid => True) in Compare_LE
then
return True;
end if;
Val : Uint;
Valr : Ureal;
+ pragma Warnings (Off, Assume_Valid);
+ -- For now Assume_Valid is unreferenced since the current implementation
+ -- always returns False if N is not a compile time known value, but we
+ -- keep the parameter to allow for future enhancements in which we try
+ -- to get the information in the variable case as well.
+
begin
-- Universal types have no range limits, so always in range
Hi : Node_Id;
LB_Known : Boolean;
UB_Known : Boolean;
- Typt : Entity_Id;
begin
- if Assume_Valid
- or else Assume_No_Invalid_Values
- or else (Is_Entity_Name (N)
- and then Is_Known_Valid (Entity (N)))
- then
- Typt := Typ;
- else
- Typt := Underlying_Type (Base_Type (Typ));
- end if;
-
- Lo := Type_Low_Bound (Typt);
- Hi := Type_High_Bound (Typt);
+ Lo := Type_Low_Bound (Typ);
+ Hi := Type_High_Bound (Typ);
LB_Known := Compile_Time_Known_Value (Lo);
UB_Known := Compile_Time_Known_Value (Hi);
-- Fixed point types should be considered as such only in
-- flag Fixed_Int is set to False.
- if Is_Floating_Point_Type (Typt)
- or else (Is_Fixed_Point_Type (Typt) and then not Fixed_Int)
+ if Is_Floating_Point_Type (Typ)
+ or else (Is_Fixed_Point_Type (Typ) and then not Fixed_Int)
or else Int_Real
then
Valr := Expr_Value_R (N);
Val : Uint;
Valr : Ureal;
+ pragma Warnings (Off, Assume_Valid);
+ -- For now Assume_Valid is unreferenced since the current implementation
+ -- always returns False if N is not a compile time known value, but we
+ -- keep the parameter to allow for future enhancements in which we try
+ -- to get the information in the variable case as well.
+
begin
-- Universal types have no range limits, so always in range
Hi : Node_Id;
LB_Known : Boolean;
UB_Known : Boolean;
- Typt : Entity_Id;
begin
- -- Go to base type if we could have invalid values
-
- if Assume_Valid
- or else Assume_No_Invalid_Values
- or else (Is_Entity_Name (N)
- and then Is_Known_Valid (Entity (N)))
- then
- Typt := Typ;
- else
- Typt := Underlying_Type (Base_Type (Typ));
- end if;
-
- Lo := Type_Low_Bound (Typt);
- Hi := Type_High_Bound (Typt);
+ Lo := Type_Low_Bound (Typ);
+ Hi := Type_High_Bound (Typ);
LB_Known := Compile_Time_Known_Value (Lo);
UB_Known := Compile_Time_Known_Value (Hi);
-- as being of a real type if the flag Fixed_Int is set,
-- since in that case they are regarded as integer types).
- if Is_Floating_Point_Type (Typt)
- or else (Is_Fixed_Point_Type (Typt) and then not Fixed_Int)
+ if Is_Floating_Point_Type (Typ)
+ or else (Is_Fixed_Point_Type (Typ) and then not Fixed_Int)
or else Int_Real
then
Valr := Expr_Value_R (N);
Fixed_Int : Boolean := False;
Int_Real : Boolean := False) return Boolean;
-- Returns True if it can be guaranteed at compile time that expression is
- -- known to be in range of the subtype Typ. If the values of N or of either
- -- bounds of Type are unknown at compile time, False will always be
- -- returned. A result of False does not mean that the expression is out of
- -- range, merely that it cannot be determined at compile time that it is in
- -- range. If Typ is a floating point type or Int_Real is set, any integer
- -- value is treated as though it was a real value (i.e. the underlying real
- -- value is used). In this case we use the corresponding real value, both
- -- for the bounds of Typ, and for the value of the expression N. If Typ is
- -- a fixed type or a discrete type and Int_Real is False but flag Fixed_Int
- -- is True then any fixed-point value is treated as though it was discrete
- -- value (i.e. the underlying integer value is used). In this case we use
- -- the corresponding integer value, both for the bounds of Typ, and for the
- -- value of the expression N. If Typ is a discrete type and Fixed_Int as
- -- well as Int_Real are false, integer values are used throughout. The
- -- Assume_Valid parameter determines whether values are to be assumed to
- -- be valid (True), or invalid values can occur (False).
+ -- known to be in range of the subtype Typ. A result of False does not mean
+ -- that the expression is out of range, merely that it cannot be determined
+ -- at compile time that it is in range. If Typ is a floating point type or
+ -- Int_Real is set, any integer value is treated as though it was a real
+ -- value (i.e. the underlying real value is used). In this case we use the
+ -- corresponding real value, both for the bounds of Typ, and for the value
+ -- of the expression N. If Typ is a fixed type or a discrete type and
+ -- Int_Real is False but flag Fixed_Int is True then any fixed-point value
+ -- is treated as though it was discrete value (i.e. the underlying integer
+ -- value is used). In this case we use the corresponding integer value,
+ -- both for the bounds of Typ, and for the value of the expression N. If
+ -- Typ is a discrete type and Fixed_Int as well as Int_Real are false,
+ -- integer values are used throughout.
+ --
+ -- If Assume_Valid is set True, then N is always assumed to contain a valid
+ -- value. If Assume_Valid is set False, then N may be invalid (unless there
+ -- is some independent way of knowing that it is valid, i.e. either it is
+ -- an entity with Is_Known_Valid set, or Assume_No_Invalid_Values is True.
function Is_Out_Of_Range
(N : Node_Id;
Int_Real : Boolean := False) return Boolean;
-- Returns True if it can be guaranteed at compile time that expression is
-- known to be out of range of the subtype Typ. True is returned if Typ is
- -- a scalar type, at least one of whose bounds is known at compile time,
- -- and N is a compile time known expression which can be determined to be
- -- outside a compile_time known bound of Typ. A result of False does not
- -- mean that the expression is in range, but rather merely that it cannot
- -- be determined at compile time that it is out of range. Flags Int_Real
- -- and Fixed_Int are used as in routine Is_In_Range above. The Assume_Valid
- -- parameter determines whether values are to be assumed to be valid
- -- (True), or invalid values can occur (False).
+ -- a scalar type, and the value of N can be determined to be outside the
+ -- range of Typ. A result of False does not mean that the expression is in
+ -- range, but rather merely that it cannot be determined at compile time
+ -- that it is out of range. The parameters Assume_Valid, Fixed_Int, and
+ -- Int_Real are as described for Is_In_Range above.
function In_Subrange_Of
- (T1 : Entity_Id;
- T2 : Entity_Id;
- Assume_Valid : Boolean;
- Fixed_Int : Boolean := False) return Boolean;
+ (T1 : Entity_Id;
+ T2 : Entity_Id;
+ Fixed_Int : Boolean := False) return Boolean;
-- Returns True if it can be guaranteed at compile time that the range of
-- values for scalar type T1 are always in the range of scalar type T2. A
-- result of False does not mean that T1 is not in T2's subrange, only that
-- it cannot be determined at compile time. Flag Fixed_Int is used as in
- -- routine Is_In_Range above. If Assume_Valid is true, the result reflects
- -- the result of assuming that entities involved in the comparison have
- -- valid representations.
+ -- routine Is_In_Range above.
function Is_Null_Range (Lo : Node_Id; Hi : Node_Id) return Boolean;
-- Returns True if it can guarantee that Lo .. Hi is a null range. If it
-- --
-- B o d y --
-- --
--- Copyright (C) 1992-2008, Free Software Foundation, Inc. --
+-- Copyright (C) 1992-2009, 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- --
then
if Scope (E) /= Scope (Alias (E)) then
Error_Pragma_Ref
- ("cannot apply pragma% to non-local renaming&#", E);
+ ("cannot apply pragma% to non-local entity&#", E);
end if;
+
E := Alias (E);
elsif Nkind_In (Parent (E), N_Full_Type_Declaration,
and then Scope (E1) /= Scope (Alias (E1))
then
Error_Pragma_Ref
- ("cannot apply pragma% to non-local renaming&#", E1);
+ ("cannot apply pragma% to non-local entity& declared#",
+ E1);
end if;
+
Set_Convention_From_Pragma (E1);
if Prag_Id = Pragma_Import then
end if;
elsif Chr = LF then
- if Source (P + 1) = CR then
- P := P + 2;
- else
- P := P + 1;
- end if;
+ P := P + 1;
elsif Chr = FF or else Chr = VT then
P := P + 1;
-- significance, but they are significant for error reporting purposes,
-- since errors are identified by line and column location.
--- In GNAT, a physical line is ended by any of the sequences LF, CR/LF, CR or
--- LF/CR. LF is used in typical Unix systems, CR/LF in DOS systems, and CR
--- alone in System 7. We don't know of any system using LF/CR, but it seems
--- reasonable to include this case for consistency. In addition, we recognize
--- any of these sequences in any of the operating systems, for better
--- behavior in treating foreign files (e.g. a Unix file with LF terminators
--- transferred to a DOS system). Finally, wide character codes in categories
--- Separator, Line and Separator, Paragraph are considered to be physical
--- line terminators.
+-- In GNAT, a physical line is ended by any of the sequences LF, CR/LF, or
+-- CR. LF is used in typical Unix systems, CR/LF in DOS systems, and CR
+-- alone in System 7. In addition, we recognize any of these sequences in
+-- any of the operating systems, for better behavior in treating foreign
+-- files (e.g. a Unix file with LF terminators transferred to a DOS system).
+-- Finally, wide character codes in categories Separator, Line and Separator,
+-- Paragraph are considered to be physical line terminators.
with Alloc;
with Casing; use Casing;
-- CR on its own (MAC System 7)
-- LF on its own (Unix and unix-like systems)
-- CR/LF (DOS, Windows)
- -- LF/CR (not used, but recognized in any case)
-- Wide character in Separator,Line or Separator,Paragraph category
--
+ -- Note: we no longer recognize LF/CR (which we did in some earlier
+ -- versions of GNAT. The reason for this is that this sequence is not
+ -- used and recognizing it generated confusion. For example given the
+ -- sequence LF/CR/LF we were interpreting that as (LF/CR) ending the
+ -- first line and a blank line ending with CR following, but it is
+ -- clearly better to interpret this as LF, with a blank line terminated
+ -- by CR/LF, given that LF and CR/LF are both in common use, but no
+ -- system we know of uses LF/CR.
+ --
-- A logical line ending (that is not a physical line ending) is one of:
--
-- VT on its own
end if;
end if;
- -- Check DOS line terminator (ignore EOF, since we only get called
- -- with an EOF if it is the last character in the buffer, and was
- -- therefore not present in the sources
+ -- Check DOS line terminator
if Style_Check_DOS_Line_Terminator then
+
+ -- Ignore EOF, since we only get called with an EOF if it is the last
+ -- character in the buffer (and was therefore not in the source file),
+ -- since the terminating EOF is added to stop the scan.
+
if Source (Scan_Ptr) = EOF then
null;
- elsif Source (Scan_Ptr) /= LF
- or else Source (Scan_Ptr + 1) = CR
- then
+
+ -- Bad terminator if we don't have an LF
+
+ elsif Source (Scan_Ptr) /= LF then
Error_Msg_S ("(style) incorrect line terminator");
end if;
end if;
Switch : Character);
-- Scan natural integer parameter for switch. On entry, Ptr points just
-- past the switch character, on exit it points past the last digit of the
- -- integer value.
+ -- integer value. Max is the maximum allowed value of Ptr, so the scan is
+ -- restricted to Switch_Chars (Ptr .. Max). It is posssible for Ptr to be
+ -- one greater than Max on return if the entire string is digits.
procedure Scan_Pos
(Switch_Chars : String;
-- Specifies the main project file to be used. The project files rooted
-- at the main project file will be parsed before looking for sources.
-- The source and object directories to be searched will be communicated
- -- to gnatfind through logical names ADA_PRJ_INCLUDE_FILE and
+ -- to gnatfind through logical names ADA_PRJ_INCLUDE_FILE and
-- ADA_PRJ_OBJECTS_FILE.
S_Find_Ref : aliased constant S := "/REFERENCES " &
--
-- Specify the case of Ada keywords. The default is keywords in lower
-- case.
+ --
-- keyword-option may be one of the following:
--
-- LOWER_CASE (D)
-- /MAX_INDENT=nnn
--
-- Do not use an additional indentation level for case alternatives
- -- and variants if their number is nnn or more. The default is 10.
- -- If nnn is zero, an additional indentation level is used for any number
- -- of case alternatives and variants.
+ -- and variants if their number is nnn or more. The default is 10.
+ -- If nnn is zero, an additional indentation level is used for any
+ -- number of case alternatives and variants.
S_Pretty_Mess : aliased constant S := "/MESSAGES_PROJECT_FILE=" &
"DEFAULT " &
projects / gcc.git / commitdiff