+2012-10-02 Robert Dewar <dewar@adacore.com>
+
+ * exp_ch7.adb, sem_dim.adb, sem_dim.ads, prj-part.adb, checks.adb,
+ freeze.adb, sem_ch4.adb, sem_ch13.adb: Minor reformatting.
+
+2012-10-02 Robert Dewar <dewar@adacore.com>
+
+ * sem_prag.adb (Analyze_Pragma, case Overflow_Checks): Fix
+ typo preventing proper processing of Overflow_Checks pragmas
+ for general case.
+
+2012-10-02 Robert Dewar <dewar@adacore.com>
+
+ * exp_ch4.adb (Expand_N_Op_Mod): Fix crash in ELIMINATED overflow
+ checks mode when bignum mode is used.
+
+2012-10-02 Robert Dewar <dewar@adacore.com>
+
+ * stylesw.ads, gnat_ugn.texi: Document new style rule for NOT IN.
+ * par-ch4.adb (P_Relational_Operator): Add style check for NOT IN.
+ * style.ads, styleg.adb, styleg.ads (Check_Not_In): New procedure.
+
2012-10-02 Vincent Pucci <pucci@adacore.com>
* sem_attr.adb (Analyze_Attribute): Check dimension for attribute
-- IN IN
if Ekind (Formal_1) = E_In_Parameter
- and then Ekind (Formal_2) = E_In_Parameter
+ and then
+ Ekind (Formal_2) = E_In_Parameter
then
return False;
-- Extract the subprogram specification and declaration nodes
Subp_Spec := Parent (Subp);
+
if Nkind (Subp_Spec) = N_Defining_Program_Unit_Name then
Subp_Spec := Parent (Subp_Spec);
end if;
+
Subp_Decl := Parent (Subp_Spec);
if not Comes_From_Source (Subp)
or else Is_Formal_Subprogram (Subp)
- -- Do not process imported subprograms since pre and post conditions
- -- are never verified on routines coming from a different language.
+ -- Do not process imported subprograms since pre and post conditions
+ -- are never verified on routines coming from a different language.
or else Is_Imported (Subp)
or else Is_Intrinsic_Subprogram (Subp)
- -- The PPC pragmas generated by this routine do not correspond to
- -- source aspects, therefore they cannot be applied to abstract
- -- subprograms.
+ -- The PPC pragmas generated by this routine do not correspond to
+ -- source aspects, therefore they cannot be applied to abstract
+ -- subprograms.
or else Nkind (Subp_Decl) = N_Abstract_Subprogram_Declaration
- -- Do not consider subprogram renaminds because the renamed entity
- -- already has the proper PPC pragmas.
+ -- Do not consider subprogram renaminds because the renamed entity
+ -- already has the proper PPC pragmas.
or else Nkind (Subp_Decl) = N_Subprogram_Renaming_Declaration
- -- Do not process null procedures because there is no benefit of
- -- adding the checks to a no action routine.
+ -- Do not process null procedures because there is no benefit of
+ -- adding the checks to a no action routine.
or else (Nkind (Subp_Spec) = N_Procedure_Specification
- and then Null_Present (Subp_Spec))
+ and then Null_Present (Subp_Spec))
then
return;
end if;
Next_Formal (Formal);
end loop;
- -- Generate the following scalar initialization check for a function
- -- result:
+ -- Generate following scalar initialization check for function result:
-- Post => Subp'Result'Valid[_Scalars]
- if Check_Validity_Of_Parameters
- and then Ekind (Subp) = E_Function
- then
+ if Check_Validity_Of_Parameters and then Ekind (Subp) = E_Function then
Add_Validity_Check (Subp, Name_Postcondition, True);
end if;
end Apply_Parameter_Validity_Checks;
if Is_OK_Static_Expression (N) then
if Present (Static_Predicate (Typ)) then
- if Operating_Mode < Generate_Code or else
- Eval_Static_Predicate_Check (N, Typ)
+ if Operating_Mode < Generate_Code
+ or else Eval_Static_Predicate_Check (N, Typ)
then
return;
else
begin
Binary_Op_Validity_Checks (N);
+ if Is_Integer_Type (Etype (N)) then
+ Apply_Divide_Checks (N);
+ end if;
+
Determine_Range (Right, ROK, Rlo, Rhi, Assume_Valid => True);
Determine_Range (Left, LOK, Llo, Lhi, Assume_Valid => True);
-- Otherwise, normal mod processing
else
- if Is_Integer_Type (Etype (N)) then
- Apply_Divide_Checks (N);
- end if;
-
-- Apply optimization x mod 1 = 0. We don't really need that with
-- gcc, but it is useful with other back ends (e.g. AAMP), and is
-- certainly harmless.
-- the mod value is always 0, and we can just ignore the left operand
-- completely in this case.
- -- The operand type may be private (e.g. in the expansion of an
- -- intrinsic operation) so we must use the underlying type to get the
- -- bounds, and convert the literals explicitly.
+ -- This only applies if we still have a mod operator. Skip if we
+ -- have already rewritten this (e.g. in the case of eliminated
+ -- overflow checks which have driven us into bignum mode).
- LLB :=
- Expr_Value
- (Type_Low_Bound (Base_Type (Underlying_Type (Etype (Left)))));
+ if Nkind (N) = N_Op_Mod then
- if ((not ROK) or else (Rlo <= (-1) and then (-1) <= Rhi))
- and then
- ((not LOK) or else (Llo = LLB))
- then
- Rewrite (N,
- Make_Conditional_Expression (Loc,
- Expressions => New_List (
- Make_Op_Eq (Loc,
- Left_Opnd => Duplicate_Subexpr (Right),
- Right_Opnd =>
- Unchecked_Convert_To (Typ,
- Make_Integer_Literal (Loc, -1))),
- Unchecked_Convert_To (Typ,
- Make_Integer_Literal (Loc, Uint_0)),
- Relocate_Node (N))));
+ -- The operand type may be private (e.g. in the expansion of an
+ -- intrinsic operation) so we must use the underlying type to get
+ -- the bounds, and convert the literals explicitly.
- Set_Analyzed (Next (Next (First (Expressions (N)))));
- Analyze_And_Resolve (N, Typ);
+ LLB :=
+ Expr_Value
+ (Type_Low_Bound (Base_Type (Underlying_Type (Etype (Left)))));
+
+ if ((not ROK) or else (Rlo <= (-1) and then (-1) <= Rhi))
+ and then
+ ((not LOK) or else (Llo = LLB))
+ then
+ Rewrite (N,
+ Make_Conditional_Expression (Loc,
+ Expressions => New_List (
+ Make_Op_Eq (Loc,
+ Left_Opnd => Duplicate_Subexpr (Right),
+ Right_Opnd =>
+ Unchecked_Convert_To (Typ,
+ Make_Integer_Literal (Loc, -1))),
+ Unchecked_Convert_To (Typ,
+ Make_Integer_Literal (Loc, Uint_0)),
+ Relocate_Node (N))));
+
+ Set_Analyzed (Next (Next (First (Expressions (N)))));
+ Analyze_And_Resolve (N, Typ);
+ end if;
end if;
end if;
end Expand_N_Op_Mod;
-- iterator specification, where a block is created for the expression
-- that build the container.
- elsif Nkind (Wrap_Node) = N_Iteration_Scheme
- or else Nkind (Wrap_Node) = N_Iterator_Specification
+ elsif Nkind_In (Wrap_Node, N_Iteration_Scheme,
+ N_Iterator_Specification)
then
null;
Apply_Parameter_Validity_Checks (E);
end if;
- -- Deal with delayed aspect specifications. The analysis of the
- -- aspect is required to be delayed to the freeze point, thus we
- -- analyze the pragma or attribute definition clause in the tree at
- -- this point. We also analyze the aspect specification node at the
- -- freeze point when the aspect doesn't correspond to
- -- pragma/attribute definition clause.
+ -- Deal with delayed aspect specifications. The analysis of the aspect
+ -- is required to be delayed to the freeze point, thus we analyze the
+ -- pragma or attribute definition clause in the tree at this point. We
+ -- also analyze the aspect specification node at the freeze point when
+ -- the aspect doesn't correspond to pragma/attribute definition clause.
if Has_Delayed_Aspects (E) then
Analyze_Aspects_At_Freeze_Point (E);
A vertical bar must be surrounded by spaces.
@end itemize
+@item
+Exactly one blank (and no other white space) must appear between
+a @code{not} token and a following @code{in} token.
+
@item ^u^UNNECESSARY_BLANK_LINES^
@emph{Check unnecessary blank lines.}
Unnecessary blank lines are not allowed. A blank line is considered
Scan; -- past operator token
+ -- Deal with NOT IN, if previous token was NOT, we must have IN now
+
if Prev_Token = Tok_Not then
+
+ -- Style check, for NOT IN, we require one space between NOT and IN
+
+ if Style_Check and then Token = Tok_In then
+ Style.Check_Not_In;
+ end if;
+
T_In;
end if;
Env : in out Environment);
-- Parse the imported projects that have been stored in table Withs, if
-- any. From_Extended is used for the call to Parse_Single_Project below.
+ --
-- When In_Limited is True, the importing path includes at least one
-- "limited with". When Limited_Withs is False, only non limited withed
-- projects are parsed. When Limited_Withs is True, only limited withed
-- projects are parsed.
+ --
-- Is_Config_File should be set to True if the project represents a config
-- file (.cgpr) since some specific checks apply.
-- If we have one, get the project id of the limited
-- imported project file, and do not parse it.
- if (In_Limited or else Limited_Withs) and then
- Project_Stack.Last > 1
+ if (In_Limited or Limited_Withs)
+ and then Project_Stack.Last > 1
then
declare
Canonical_Path_Name : Path_Name_Type;
end;
end if;
- -- Parse the imported project, if its project id is unknown
+ -- Parse the imported project if its project id is unknown
if No (Withed_Project) then
Parse_Single_Project
Path_Name_Id => Imported_Path_Name_Id,
Extended => False,
From_Extended => From_Extended,
- In_Limited => In_Limited or else Limited_Withs,
+ In_Limited => In_Limited or Limited_Withs,
Packages_To_Check => Packages_To_Check,
Depth => Depth,
Current_Dir => Current_Dir,
Indexing_Found : Boolean;
procedure Check_One_Function (Subp : Entity_Id);
- -- Check one possible interpretation
+ -- Check one possible interpretation. Sets Indexing_Found True if an
+ -- indexing function is found.
------------------------
-- Check_One_Function --
-- An indexing function must return either the default element of
-- the container, or a reference type. For variable indexing it
- -- must be latter.
+ -- must be the latter.
if Present (Default_Element) then
Analyze (Default_Element);
+
if Is_Entity_Name (Default_Element)
and then Covers (Entity (Default_Element), Etype (Subp))
then
end if;
end if;
- -- For variable_indexing the return type must be a reference type.
+ -- For variable_indexing the return type must be a reference type
if Attr = Name_Variable_Indexing
and then not Has_Implicit_Dereference (Etype (Subp))
Get_Next_Interp (I, It);
end loop;
+
if not Indexing_Found then
- Error_Msg_NE (
- "aspect Indexing requires a function that applies to type&",
- Expr, Ent);
+ Error_Msg_NE
+ ("aspect Indexing requires a function that "
+ & "applies to type&", Expr, Ent);
end if;
end;
end if;
if Is_Array_Type (Typ)
and then Compile_Time_Known_Bounds (Typ)
and then
- (Expr_Value (Type_Low_Bound (Etype (First_Index (Typ))))
- > Expr_Value (Type_High_Bound (Etype (First_Index (Typ)))))
+ (Expr_Value (Type_Low_Bound (Etype (First_Index (Typ)))) >
+ Expr_Value (Type_High_Bound (Etype (First_Index (Typ)))))
then
Preanalyze_And_Resolve (Condition (N), Standard_Boolean);
-- Check the dimensions of the actuals, if any
if not Is_Empty_List (Actuals) then
+
-- Special processing for elementary functions
-- For Sqrt call, the resulting dimensions equal to half the
function Is_Elementary_Function_Entity
(Sub_Id : Entity_Id) return Boolean;
- -- Given Sub_Id, the original subprogram entity, return True if
- -- call is to an elementary function
- -- (see Ada.Numerics.Generic_Elementary_Functions).
+ -- Given Sub_Id, the original subprogram entity, return True
+ -- if call is to an elementary function (see Ada.Numerics.
+ -- Generic_Elementary_Functions).
-----------------------------------
-- Is_Elementary_Function_Entity --
Loc : constant Source_Ptr := Sloc (Sub_Id);
begin
- -- Is function entity in
- -- Ada.Numerics.Generic_Elementary_Functions?
+ -- Is entity in Ada.Numerics.Generic_Elementary_Functions?
return
Loc > No_Location
-- Start of processing for Elementary_Function_Calls
begin
- -- Get the original subprogram entity following the renaming
- -- chain.
+ -- Get original subprogram entity following the renaming chain
if Present (Alias (Ent)) then
Ent := Alias (Ent);
-- Check the call is an Elementary function call
if Is_Elementary_Function_Entity (Ent) then
+
-- Sqrt function call case
if Chars (Ent) = Name_Sqrt then
for Position in Dims_Of_Call'Range loop
Dims_Of_Call (Position) :=
Dims_Of_Call (Position) *
- Rational'(Numerator => 1,
- Denominator => 2);
+ Rational'(Numerator => 1, Denominator => 2);
end loop;
Set_Dimensions (N, Dims_Of_Call);
while Present (Actual) loop
if Exists (Dimensions_Of (Actual)) then
- -- Check if error has already been encountered so
- -- far.
+ -- Check if error has already been encountered
if not Error_Detected then
Error_Msg_NE ("dimensions mismatch in call of&",
Error_Detected := True;
end if;
- Error_Msg_N ("\expected dimension " &
- Dimensions_Msg_Of (Formal_Typ) & ", found " &
- Dimensions_Msg_Of (Actual),
- Actual);
+ Error_Msg_N
+ ("\expected dimension " & Dimensions_Msg_Of (Formal_Typ)
+ & ", found " & Dimensions_Msg_Of (Actual), Actual);
end if;
Next_Actual (Actual);
procedure Analyze_Dimension_Has_Etype (N : Node_Id) is
Etyp : constant Entity_Id := Etype (N);
- Dims_Of_Etyp : Dimension_Type := Dimensions_Of (Etyp);
+ Dims_Of_Etyp : Dimension_Type := Dimensions_Of (Etyp);
begin
-- General case. Propagation of the dimensions from the type
-- Removal of dimensions in expression
case Nkind (N) is
-
when N_Attribute_Reference |
N_Indexed_Component =>
declare
Remove_Dimensions (Selector_Name (N));
when others => null;
-
end case;
end Analyze_Dimension_Has_Etype;
procedure Copy_Dimensions (From, To : Node_Id);
-- Copy dimension vector of node From to node To. Note that To must be a
- -- node that is allowed to contain a dimension. (See OK_For_Dimension in
+ -- node that is allowed to contain a dimension (see OK_For_Dimension in
-- body of Sem_Dim).
procedure Eval_Op_Expon_For_Dimensioned_Type
-- Process first argument
- Suppress_Options.Overflow_Checks_General :=
+ Scope_Suppress.Overflow_Checks_General :=
Get_Check_Mode (Name_General, Arg1);
-- Case of only one argument
-- --
-- S p e c --
-- --
--- Copyright (C) 1992-2010, Free Software Foundation, Inc. --
+-- Copyright (C) 1992-2012, 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- --
-- check the line length (Len is the length of the current line). Note that
-- the terminator may be the EOF character.
+ procedure Check_Not_In
+ renames Style_Inst.Check_Not_In;
+ -- Called with Scan_Ptr pointing to an IN token, and Prev_Token_Ptr
+ -- pointing to a NOT token. Used to check proper layout of NOT IN.
+
procedure Check_Pragma_Name
renames Style_Inst.Check_Pragma_Name;
-- The current token is a pragma identifier. Check that it is spelled
-- --
-- B o d y --
-- --
--- Copyright (C) 1992-2011, Free Software Foundation, Inc. --
+-- Copyright (C) 1992-2012, 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- --
end if;
end Check_Line_Terminator;
+ ------------------
+ -- Check_Not_In --
+ ------------------
+
+ -- In check tokens mode, only one space between NOT and IN
+
+ procedure Check_Not_In is
+ begin
+ if Style_Check_Tokens then
+ if Source (Token_Ptr - 1) /= ' '
+ or else Token_Ptr - Prev_Token_Ptr /= 4
+ then -- CODEFIX?
+ Error_Msg
+ ("(style) single space must separate NOT and IN", Token_Ptr - 1);
+ end if;
+ end if;
+ end Check_Not_In;
+
--------------------------
-- Check_No_Space_After --
--------------------------
-- --
-- S p e c --
-- --
--- Copyright (C) 1992-2010, Free Software Foundation, Inc. --
+-- Copyright (C) 1992-2012, 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- --
-- the current line, used to check for appropriate line terminator usage.
-- The parameter Len is the length of the current line.
+ procedure Check_Not_In;
+ -- Called with Scan_Ptr pointing to an IN token, and Prev_Token_Ptr
+ -- pointing to a NOT token. Used to check proper layout of NOT IN.
+
procedure Check_Pragma_Name;
-- The current token is a pragma identifier. Check that it is spelled
-- properly (i.e. with an appropriate casing convention).
-- --
-- S p e c --
-- --
--- Copyright (C) 1992-2011, Free Software Foundation, Inc. --
+-- Copyright (C) 1992-2012, 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- --
--
-- A unary plus or minus may not be followed by a space
--
+ -- There must be one blank (and no other white space) between NOT and IN
+ --
-- A vertical bar must be surrounded by spaces
--
-- Note that a requirement that a token be preceded by a space is met by
git://gcc.gnu.org / gcc.git / commitdiff