+2009-05-06 Sergey Rybin <rybin@adacore.com>
+
+ * gnat_ugn.texi: For Misnamed_Identifiers rule all description of the
+ new form of the rule parameter that allows to specify the suffix for
+ access-to-access type names.
+
+2009-05-06 Robert Dewar <dewar@adacore.com>
+
+ * sem_warn.adb (Warn_On_Useless_Assignment): Avoid false negative for
+ out parameter assigned when exception handlers are present.
+
+ * sem_ch5.adb (Analyze_Exit_Statement): Kill current value last
+ assignments on exit.
+
+ * par-ch9.adb, sem_aggr.adb, par-endh.adb, sem_res.adb, par-ch6.adb,
+ sinput-l.adb, par-load.adb, errout.ads, sem_ch4.adb, lib-load.adb,
+ prj-dect.adb, par-ch12.adb, sem_ch8.adb, par-util.adb, par-ch3.adb,
+ par-tchk.adb, par-ch5.adb: This patch adds stylized comments to error
+ messages that are included in the codefix circuitry of IDE's such as
+ GPS.
+
+ * sinput.ads, sinput.adb (Expr_First_Char): New function
+ (Expr_Last_Char): New function
+
2009-05-06 Sergey Rybin <rybin@adacore.com>
* gnat_ugn.texi: Add subsection for Exits_From_Conditional_Loops rule
-- Triggering switch. If non-zero, then ignore errors mode is activated.
-- This is a counter to allow convenient nesting of enable/disable.
+ -----------------------
+ -- CODEFIX Facility --
+ -----------------------
+
+ -- The GPS and GNATBench IDE's have a codefix facility that allows for
+ -- automatic correction of a subset of the errors and warnings issued
+ -- by the compiler. This is done by recognizing the text of specific
+ -- messages using appropriate matching patterns.
+
+ -- The text of such messages should not be altered without coordinating
+ -- with the codefix code. All such messages are marked by a specific
+ -- style of comments, as shown by the following example:
+
+ -- Error_Msg_N -- CODEFIX
+ -- (parameters ....)
+
+ -- Any message marked with this -- CODEFIX comment should not be modified
+ -- without appropriate coordination. If new messages are added which may
+ -- be susceptible to automatic codefix action, they are marked using:
+
+ -- Error_Msg -- CODEFIX???
+ -- (parameters)
+
+ -- And subsequently either the appropriate code is added to codefix and the
+ -- ??? are removed, or it is determined that this is not an appropriate
+ -- case for codefix action, and the comment is removed.
+
------------------------------
-- Error Output Subprograms --
------------------------------
Specifies the suffix for an access type name. If
this parameter is set, it overrides for access
types the suffix set by the @code{Type_Suffix} parameter.
+For access types, @emph{string} may have the following format:
+@emph{suffix1(suffix2)}. That means that an access type name
+should have the @emph{suffix1} suffix except for the case when
+the designated type is also an access type, in this case the
+type name should have the @emph{suffix1 & suffix2} suffix.
@item Constant_Suffix=@emph{string}
Specifies the suffix for a constant name.
Check_Restricted_Unit (Load_Name, Error_Node);
Error_Msg_Unit_1 := Uname_Actual;
- Error_Msg
+ Error_Msg -- CODEFIX
("$$ is not a predefined library unit", Load_Msg_Sloc);
else
-- --
-- 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- --
Scan; -- past GENERIC
if Token = Tok_Private then
- Error_Msg_SC ("PRIVATE goes before GENERIC, not after");
+ Error_Msg_SC -- CODEFIX
+ ("PRIVATE goes before GENERIC, not after");
Scan; -- past junk PRIVATE token
end if;
Append (P_Formal_Subprogram_Declaration, Decls);
else
- Error_Msg_BC
+ Error_Msg_BC -- CODEFIX
("FUNCTION, PROCEDURE or PACKAGE expected here");
Resync_Past_Semicolon;
end if;
else
if Token = Tok_Abstract then
- Error_Msg_SC ("ABSTRACT must come before LIMITED");
+ Error_Msg_SC -- CODEFIX
+ ("ABSTRACT must come before LIMITED");
Scan; -- past improper ABSTRACT
if Token = Tok_New then
if Token = Tok_Abstract then
if Prev_Token = Tok_Tagged then
- Error_Msg_SC ("ABSTRACT must come before TAGGED");
+ Error_Msg_SC -- CODEFIX
+ ("ABSTRACT must come before TAGGED");
elsif Prev_Token = Tok_Limited then
- Error_Msg_SC ("ABSTRACT must come before LIMITED");
+ Error_Msg_SC -- CODEFIX
+ ("ABSTRACT must come before LIMITED");
end if;
Resync_Past_Semicolon;
elsif Token = Tok_Tagged then
- Error_Msg_SC ("TAGGED must come before LIMITED");
+ Error_Msg_SC -- CODEFIX
+ ("TAGGED must come before LIMITED");
Resync_Past_Semicolon;
end if;
-- --
-- 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- --
end if;
if Token = Tok_Abstract then
- Error_Msg_SC ("ABSTRACT must come before TAGGED");
+ Error_Msg_SC -- CODEFIX
+ ("ABSTRACT must come before TAGGED");
Abstract_Present := True;
Abstract_Loc := Token_Ptr;
Scan; -- past ABSTRACT
loop
if Token = Tok_Tagged then
- Error_Msg_SC ("TAGGED must come before LIMITED");
+ Error_Msg_SC -- CODEFIX
+ ("TAGGED must come before LIMITED");
Scan; -- past TAGGED
elsif Token = Tok_Abstract then
- Error_Msg_SC ("ABSTRACT must come before LIMITED");
+ Error_Msg_SC -- CODEFIX
+ ("ABSTRACT must come before LIMITED");
Scan; -- past ABSTRACT
else
end if;
if Token = Tok_Aliased then
- Error_Msg_SC ("ALIASED should be before CONSTANT");
+ Error_Msg_SC -- CODEFIX
+ ("ALIASED should be before CONSTANT");
Scan; -- past ALIASED
Set_Aliased_Present (Decl_Node, True);
end if;
end if;
if Token = Tok_Abstract then
- Error_Msg_SC ("ABSTRACT must come before NEW, not after");
+ Error_Msg_SC -- CODEFIX
+ ("ABSTRACT must come before NEW, not after");
Scan;
end if;
-- Handle decimal fixed-point defn with DIGITS/DELTA in wrong order
if Token = Tok_Delta then
- Error_Msg_SC ("|DELTA must come before DIGITS");
+ Error_Msg_SC -- CODEFIX
+ ("|DELTA must come before DIGITS");
Def_Node := New_Node (N_Decimal_Fixed_Point_Definition, Digits_Loc);
Scan; -- past DELTA
Set_Delta_Expression (Def_Node, P_Expression_No_Right_Paren);
Scan; -- past PROTECTED
if Token /= Tok_Procedure and then Token /= Tok_Function then
- Error_Msg_SC ("FUNCTION or PROCEDURE expected");
+ Error_Msg_SC -- CODEFIX
+ ("FUNCTION or PROCEDURE expected");
end if;
end if;
-- --
-- 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- --
procedure Junk_Declaration is
begin
if (not Declaration_Found) or All_Errors_Mode then
- Error_Msg_SC ("declarations must come before BEGIN");
+ Error_Msg_SC -- CODEFIX
+ ("declarations must come before BEGIN");
Declaration_Found := True;
end if;
and then Block_Label = Name_Go
and then Token_Name = Name_To
then
- Error_Msg_SP ("goto is one word");
+ Error_Msg_SP -- CODEFIX
+ ("goto is one word");
Append_To (Statement_List, P_Goto_Statement);
Statement_Required := False;
-- --
-- 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- --
Error_Msg_SC ("overriding indicator not allowed here!");
elsif Token /= Tok_Function and then Token /= Tok_Procedure then
- Error_Msg_SC ("FUNCTION or PROCEDURE expected!");
+ Error_Msg_SC -- CODEFIX
+ ("FUNCTION or PROCEDURE expected!");
end if;
end if;
Set_Constant_Present (Decl_Node);
if Token = Tok_Aliased then
- Error_Msg_SC ("ALIASED should be before CONSTANT");
+ Error_Msg_SC -- CODEFIX
+ ("ALIASED should be before CONSTANT");
Scan; -- past ALIASED
Set_Aliased_Present (Decl_Node);
end if;
-- --
-- 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- --
Set_Must_Not_Override (Specification (Decl), Not_Overriding);
else
- Error_Msg_SC ("ENTRY, FUNCTION or PROCEDURE expected!");
+ Error_Msg_SC -- CODEFIX
+ ("ENTRY, FUNCTION or PROCEDURE expected!");
end if;
end if;
-- --
-- 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- --
if Error_Msg_Name_1 > Error_Name then
if Is_Bad_Spelling_Of (Chars (Nam), Chars (End_Labl)) then
Error_Msg_Name_1 := Chars (Nam);
- Error_Msg_N ("misspelling of %", End_Labl);
+ Error_Msg_N -- CODEFIX
+ ("misspelling of %", End_Labl);
Syntax_OK := True;
return;
end if;
end if;
if End_Type = E_Case then
- Error_Msg_SC ("`END CASE;` expected@ for CASE#!");
+ Error_Msg_SC -- CODEFIX
+ ("`END CASE;` expected@ for CASE#!");
elsif End_Type = E_If then
- Error_Msg_SC ("`END IF;` expected@ for IF#!");
+ Error_Msg_SC -- CODEFIX
+ ("`END IF;` expected@ for IF#!");
elsif End_Type = E_Loop then
if Error_Msg_Node_1 = Empty then
- Error_Msg_SC
+ Error_Msg_SC -- CODEFIX
("`END LOOP;` expected@ for LOOP#!");
else
- Error_Msg_SC ("`END LOOP &;` expected@!");
+ Error_Msg_SC -- CODEFIX
+ ("`END LOOP &;` expected@!");
end if;
elsif End_Type = E_Record then
- Error_Msg_SC
+ Error_Msg_SC -- CODEFIX
("`END RECORD;` expected@ for RECORD#!");
elsif End_Type = E_Return then
- Error_Msg_SC
+ Error_Msg_SC -- CODEFIX
("`END RETURN;` expected@ for RETURN#!");
elsif End_Type = E_Select then
- Error_Msg_SC
+ Error_Msg_SC -- CODEFIX
("`END SELECT;` expected@ for SELECT#!");
-- All remaining cases are cases with a name (we do not treat
elsif End_Type = E_Name or else (not Ins) then
if Error_Msg_Node_1 = Empty then
- Error_Msg_SC ("`END;` expected@ for BEGIN#!");
+ Error_Msg_SC -- CODEFIX
+ ("`END;` expected@ for BEGIN#!");
else
- Error_Msg_SC ("`END &;` expected@!");
+ Error_Msg_SC -- CODEFIX
+ ("`END &;` expected@!");
end if;
-- The other possibility is a missing END for a subprogram with a
begin
Error_Msg_Unit_1 := Expect_Name;
- Error_Msg ("$$ is not a predefined library unit!", Loc);
+ Error_Msg -- CODEFIX
+ ("$$ is not a predefined library unit!", Loc);
-- In the predefined file case, we know the user did not
-- construct their own package, but we got the wrong one.
(Name_Id (Expect_Name), Name_Id (Actual_Name))
then
Error_Msg_Unit_1 := Actual_Name;
- Error_Msg ("possible misspelling of $$!", Loc);
+ Error_Msg -- CODEFIX
+ ("possible misspelling of $$!", Loc);
end if;
end;
-- --
-- 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- --
-- the possibility of a "C" confusion.
elsif Token = Tok_Vertical_Bar then
- Error_Msg_SC ("unexpected occurrence of ""'|"", did you mean OR'?");
+ Error_Msg_SC -- CODEFIX
+ ("unexpected occurrence of ""'|"", did you mean OR'?");
Resync_Past_Semicolon;
return;
-- --
-- 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- --
M2 (P2 + J - 1) := Fold_Upper (S (J));
end loop;
- Error_Msg_SC (M2 (1 .. P2 - 1 + S'Last));
+ Error_Msg_SC -- CODEFIX???
+ (M2 (1 .. P2 - 1 + S'Last));
Token := T;
return True;
end if;
M1 (P1 + J - 1) := Fold_Upper (S (J));
end loop;
- Error_Msg_SC (M1 (1 .. P1 - 1 + S'Last));
+ Error_Msg_SC -- CODFIX
+ (M1 (1 .. P1 - 1 + S'Last));
Token := T;
return True;
Error_Msg_Name_1 := First_Attribute_Name;
while Error_Msg_Name_1 <= Last_Attribute_Name loop
if Is_Bad_Spelling_Of (Token_Name, Error_Msg_Name_1) then
- Error_Msg_N ("\possible misspelling of %", Token_Node);
+ Error_Msg_N -- CODEFIX
+ ("\possible misspelling of %", Token_Node);
exit;
end if;
-- --
-- B o d y --
-- --
--- Copyright (C) 2001-2008, Free Software Foundation, Inc. --
+-- Copyright (C) 2001-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- --
end if;
if Index /= 0 then
- Error_Msg ("\?possible misspelling of """ &
- List (Index).all & """",
- Token_Ptr);
+ Error_Msg -- CODEFIX
+ ("\?possible misspelling of """ &
+ List (Index).all & """", Token_Ptr);
end if;
end;
end if;
-- Report at most two suggestions
if Nr_Of_Suggestions = 1 then
- Error_Msg_NE
+ Error_Msg_NE -- CODEFIX
("\possible misspelling of&", Component, Suggestion_1);
elsif Nr_Of_Suggestions = 2 then
Error_Msg_Node_2 := Suggestion_2;
- Error_Msg_NE
+ Error_Msg_NE -- CODEFIX
("\possible misspelling of& or&", Component, Suggestion_1);
end if;
end Check_Misspelled_Component;
-- --
-- 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- --
if Nkind (Constraint (E)) =
N_Index_Or_Discriminant_Constraint
then
- Error_Msg_N
+ Error_Msg_N -- CODEFIX
("\if qualified expression was meant, " &
"use apostrophe", Constraint (E));
end if;
and then Nkind (Constraint (E)) =
N_Index_Or_Discriminant_Constraint
then
- Error_Msg_N
+ Error_Msg_N -- CODEFIX
("if qualified expression was meant, " &
"use apostrophe!", Constraint (E));
end if;
Formal := First_Formal (Nam);
while Present (Formal) loop
if Chars (Left_Opnd (Actual)) = Chars (Formal) then
- Error_Msg_N
+ Error_Msg_N -- CODEFIX
("possible misspelling of `='>`!", Actual);
exit;
end if;
-- Report at most two suggestions
if Nr_Of_Suggestions = 1 then
- Error_Msg_NE
+ Error_Msg_NE -- CODEFIX
("\possible misspelling of&", Sel, Suggestion_1);
elsif Nr_Of_Suggestions = 2 then
Error_Msg_Node_2 := Suggestion_2;
- Error_Msg_NE
+ Error_Msg_NE -- CODEFIX
("\possible misspelling of& or&", Sel, Suggestion_1);
end if;
end Check_Misspelled_Selector;
if Nkind (Parent (N)) = N_Selected_Component
and then N = Prefix (Parent (N))
then
- Error_Msg_N (
- "\period should probably be semicolon", Parent (N));
+ Error_Msg_N -- CODEFIX
+ ("\period should probably be semicolon", Parent (N));
end if;
elsif Nkind (N) = N_Procedure_Call_Statement
and then Valid_Boolean_Arg (Etype (R))
then
Error_Msg_N ("invalid operands for concatenation", N);
- Error_Msg_N ("\maybe AND was meant", N);
+ Error_Msg_N -- CODEFIX
+ ("\maybe AND was meant", N);
return;
-- A special case for comparison of access parameter with null
if Nkind (Parent (Op)) = N_Full_Type_Declaration then
Error_Msg_N ("\possible interpretation (inherited)#", N);
else
- Error_Msg_N ("\possible interpretation#", N);
+ Error_Msg_N -- CODEFIX
+ ("\possible interpretation#", N);
end if;
end if;
end Report_Ambiguity;
Analyze_And_Resolve (Cond, Any_Boolean);
Check_Unset_Reference (Cond);
end if;
+
+ -- Since the exit may take us out of a loop, any previous assignment
+ -- statement is not useless, so clear last assignment indications. It
+ -- is OK to keep other current values, since if the exit statement
+ -- does not exit, then the current values are still valid.
+
+ Kill_Current_Values (Last_Assignment_Only => True);
end Analyze_Exit_Statement;
----------------------------
end if;
Error_Msg_Sloc := Sloc (Ent);
- Error_Msg_N ("hidden declaration#!", N);
+ Error_Msg_N -- CODEFIX
+ ("hidden declaration#!", N);
end if;
Ent := Homonym (Ent);
Error_Msg_N
("\\possible interpretation (inherited)#!", N);
else
- Error_Msg_N ("\\possible interpretation#!", N);
+ Error_Msg_N -- CODEFIX
+ ("\\possible interpretation#!", N);
end if;
end if;
Error_Msg_N
("\\possible interpretation (inherited)#!", N);
else
- Error_Msg_N ("\\possible interpretation#!", N);
+ Error_Msg_N -- CODEFIX
+ ("\\possible interpretation#!", N);
end if;
end if;
or else Base_Type (It.Typ) =
Base_Type (Component_Type (Typ))
then
- Error_Msg_N ("\\possible interpretation#", Arg);
+ Error_Msg_N -- CODEFIX
+ ("\\possible interpretation#", Arg);
end if;
Get_Next_Interp (I, It);
Error_Msg_N ("ambiguous operand in conversion", Operand);
Error_Msg_Sloc := Sloc (It.Nam);
- Error_Msg_N ("\\possible interpretation#!", Operand);
+ Error_Msg_N -- CODEFIX
+ ("\\possible interpretation#!", Operand);
Error_Msg_Sloc := Sloc (N1);
- Error_Msg_N ("\\possible interpretation#!", Operand);
+ Error_Msg_N -- CODEFIX
+ ("\\possible interpretation#!", Operand);
return False;
end if;
X : Node_Id;
function Check_Ref (N : Node_Id) return Traverse_Result;
- -- Used to instantiate Traverse_Func. Returns Abandon if
- -- a reference to the entity in question is found.
+ -- Used to instantiate Traverse_Func. Returns Abandon if a reference to
+ -- the entity in question is found.
function Test_No_Refs is new Traverse_Func (Check_Ref);
-- variable with the last assignment field set, with warnings enabled,
-- and which is not imported or exported. We also check that it is OK
-- to capture the value. We are not going to capture any value, but
- -- the warning messages depends on the same kind of conditions.
+ -- the warning message depends on the same kind of conditions.
if Is_Assignable (Ent)
and then not Is_Return_Object (Ent)
-- Otherwise we are at the outer level. An exception
-- handler is significant only if it references the
- -- variable in question.
+ -- variable in question, or if the entity in question
+ -- is an OUT or IN OUT parameter, which which case
+ -- the caller can reference it after the exception
+ -- hanlder completes
else
- X := First (Exception_Handlers (P));
- while Present (X) loop
- if Test_No_Refs (X) = Abandon then
- Set_Last_Assignment (Ent, Empty);
- return;
- end if;
+ if Is_Formal (Ent) then
+ Set_Last_Assignment (Ent, Empty);
+ return;
- X := Next (X);
- end loop;
+ else
+ X := First (Exception_Handlers (P));
+ while Present (X) loop
+ if Test_No_Refs (X) = Abandon then
+ Set_Last_Assignment (Ent, Empty);
+ return;
+ end if;
+
+ X := Next (X);
+ end loop;
+ end if;
end if;
end if;
end if;
-- Preprocess the source if it needs to be preprocessed
if Preprocessing_Needed then
- -- Set temporarily the Source_File_Index_Table entries for the
+
+ -- Temporarily set the Source_File_Index_Table entries for the
-- source, to avoid crash when reporting an error.
Set_Source_File_Index_Table (X);
pragma Style_Checks (All_Checks);
-- Subprograms not all in alpha order
+with Atree; use Atree;
with Debug; use Debug;
with Opt; use Opt;
with Output; use Output;
with Tree_IO; use Tree_IO;
+with Sinfo; use Sinfo;
with System; use System;
with Widechar; use Widechar;
return;
end Build_Location_String;
+ ---------------------
+ -- Expr_First_Char --
+ ---------------------
+
+ function Expr_First_Char (Expr : Node_Id) return Source_Ptr is
+
+ function First_Char (Expr : Node_Id; PC : Nat) return Source_Ptr;
+ -- Internal recursive function used to traverse the expression tree.
+ -- Returns the source pointer corresponding to the first location of
+ -- the subexpression N, followed by backing up the given (PC) number of
+ -- preceding left parentheses.
+
+ ----------------
+ -- First_Char --
+ ----------------
+
+ function First_Char (Expr : Node_Id; PC : Nat) return Source_Ptr is
+ N : constant Node_Id := Original_Node (Expr);
+ Count : constant Nat := PC + Paren_Count (N);
+ Kind : constant N_Subexpr := Nkind (N);
+ Loc : Source_Ptr;
+
+ begin
+ case Kind is
+ when N_And_Then |
+ N_In |
+ N_Not_In |
+ N_Or_Else |
+ N_Binary_Op =>
+ return First_Char (Left_Opnd (N), Count);
+
+ when N_Attribute_Reference |
+ N_Expanded_Name |
+ N_Explicit_Dereference |
+ N_Indexed_Component |
+ N_Reference |
+ N_Selected_Component |
+ N_Slice =>
+ return First_Char (Prefix (N), Count);
+
+ when N_Function_Call =>
+ return First_Char (Sinfo.Name (N), Count);
+
+ when N_Qualified_Expression |
+ N_Type_Conversion =>
+ return First_Char (Subtype_Mark (N), Count);
+
+ when N_Range =>
+ return First_Char (Low_Bound (N), Count);
+
+ -- Nodes that should not appear in original expression trees
+
+ when N_Procedure_Call_Statement |
+ N_Raise_xxx_Error |
+ N_Subprogram_Info |
+ N_Unchecked_Expression |
+ N_Unchecked_Type_Conversion |
+ N_Conditional_Expression =>
+ raise Program_Error;
+
+ -- Cases where the Sloc points to the start of the tokem, but we
+ -- still need to handle the sequence of left parentheses.
+
+ when N_Identifier |
+ N_Operator_Symbol |
+ N_Character_Literal |
+ N_Integer_Literal |
+ N_Null |
+ N_Unary_Op |
+ N_Aggregate |
+ N_Allocator |
+ N_Extension_Aggregate |
+ N_Real_Literal |
+ N_String_Literal =>
+
+ Loc := Sloc (N);
+
+ if Count > 0 then
+ declare
+ SFI : constant Source_File_Index :=
+ Get_Source_File_Index (Loc);
+ Src : constant Source_Buffer_Ptr := Source_Text (SFI);
+ Fst : constant Source_Ptr := Source_First (SFI);
+
+ begin
+ for J in 1 .. Count loop
+ loop
+ exit when Loc = Fst;
+ Loc := Loc - 1;
+ exit when Src (Loc) >= ' ';
+ end loop;
+
+ exit when Src (Loc) /= '(';
+ end loop;
+ end;
+ end if;
+
+ return Loc;
+ end case;
+ end First_Char;
+
+ -- Start of processing for Expr_First_Char
+
+ begin
+ pragma Assert (Nkind (Expr) in N_Subexpr);
+ return First_Char (Expr, 0);
+ end Expr_First_Char;
+
+ --------------------
+ -- Expr_Last_Char --
+ --------------------
+
+ function Expr_Last_Char (Expr : Node_Id) return Source_Ptr is
+
+ function Last_Char (Expr : Node_Id; PC : Nat) return Source_Ptr;
+ -- Internal recursive function used to traverse the expression tree.
+ -- Returns the source pointer corresponding to the last location of
+ -- the subexpression N, followed by ztepping to the last of the given
+ -- number of right parentheses.
+
+ ---------------
+ -- Last_Char --
+ ---------------
+
+ function Last_Char (Expr : Node_Id; PC : Nat) return Source_Ptr is
+ N : constant Node_Id := Original_Node (Expr);
+ Count : constant Nat := PC + Paren_Count (N);
+ Kind : constant N_Subexpr := Nkind (N);
+ Loc : Source_Ptr;
+
+ begin
+ case Kind is
+ when N_And_Then |
+ N_In |
+ N_Not_In |
+ N_Or_Else |
+ N_Binary_Op =>
+ return Last_Char (Right_Opnd (N), Count);
+
+ when N_Attribute_Reference |
+ N_Expanded_Name |
+ N_Explicit_Dereference |
+ N_Indexed_Component |
+ N_Reference |
+ N_Selected_Component |
+ N_Slice =>
+ return Last_Char (Prefix (N), Count);
+
+ when N_Function_Call =>
+ return Last_Char (Sinfo.Name (N), Count);
+
+ when N_Qualified_Expression |
+ N_Type_Conversion =>
+ return Last_Char (Subtype_Mark (N), Count);
+
+ when N_Range =>
+ return Last_Char (Low_Bound (N), Count);
+
+ -- Nodes that should not appear in original expression trees
+
+ when N_Procedure_Call_Statement |
+ N_Raise_xxx_Error |
+ N_Subprogram_Info |
+ N_Unchecked_Expression |
+ N_Unchecked_Type_Conversion |
+ N_Conditional_Expression =>
+ raise Program_Error;
+
+ -- Cases where the Sloc points to the start of the tokem, but we
+ -- still need to handle the sequence of left parentheses.
+
+ when N_Identifier |
+ N_Operator_Symbol |
+ N_Character_Literal |
+ N_Integer_Literal |
+ N_Null |
+ N_Unary_Op |
+ N_Aggregate |
+ N_Allocator |
+ N_Extension_Aggregate |
+ N_Real_Literal |
+ N_String_Literal =>
+
+ Loc := Sloc (N);
+
+ if Count > 0 then
+ declare
+ SFI : constant Source_File_Index :=
+ Get_Source_File_Index (Loc);
+ Src : constant Source_Buffer_Ptr := Source_Text (SFI);
+ Fst : constant Source_Ptr := Source_Last (SFI);
+
+ begin
+ for J in 1 .. Count loop
+ loop
+ exit when Loc = Fst;
+ Loc := Loc - 1;
+ exit when Src (Loc) >= ' ';
+ end loop;
+
+ exit when Src (Loc) /= '(';
+ end loop;
+ end;
+ end if;
+
+ return Loc;
+ end case;
+ end Last_Char;
+
+ -- Start of processing for Expr_Last_Char
+
+ begin
+ pragma Assert (Nkind (Expr) in N_Subexpr);
+ return Last_Char (Expr, 0);
+ end Expr_Last_Char;
+
-----------------------
-- Get_Column_Number --
-----------------------
-- ASCII.NUL, with Name_Length indicating the length not including the
-- terminating Nul.
+ function Expr_First_Char (Expr : Node_Id) return Source_Ptr;
+ -- Given a node for a subexpression, returns the source location of the
+ -- first character of the expression.
+
+ function Expr_Last_Char (Expr : Node_Id) return Source_Ptr;
+ -- Given a node for a subexpression, returns the source location of the
+ -- last character of the expression.
+
function Get_Column_Number (P : Source_Ptr) return Column_Number;
-- The ones-origin column number of the specified Source_Ptr value is
-- determined and returned. Tab characters if present are assumed to
projects / gcc.git / commitdiff