[multiple changes]
2009-06-22 Robert Dewar <dewar@adacore.com> * sinput.adb, sinput.ads (Expr_First_Char, Expr_Last_Char): Replaced by Sloc_Range. * freeze.adb: Minor comment updates * s-valrea.adb (Bad_Based_Value): New procedure (Scan_Real): Raise exceptions with messages 2009-06-22 Matthew Gingell <gingell@adacore.com> * adaint.h: Complete previous change. 2009-06-22 Thomas Quinot <quinot@adacore.com> * exp_ch7.ads, exp_ch3.adb: Minor reformatting 2009-06-22 Ed Schonberg <schonberg@adacore.com> * sem_ch6.adb (Check_Overriding_Indicator): When style checks are enabled, emit warning when a non-controlling argument of the overriding operation appears out of place vis-a-vis of the formal of the overridden operation. From-SVN: r148782
This commit is contained in:
Arnaud Charlet
parent
03456e44cf
commit
e7d72fb99d
9 changed files with 189 additions and 291 deletions
|
|
@ -1,3 +1,28 @@
|
|||
2009-06-22 Robert Dewar <dewar@adacore.com>
|
||||
|
||||
* sinput.adb, sinput.ads (Expr_First_Char, Expr_Last_Char): Replaced
|
||||
by Sloc_Range.
|
||||
|
||||
* freeze.adb: Minor comment updates
|
||||
|
||||
* s-valrea.adb (Bad_Based_Value): New procedure
|
||||
(Scan_Real): Raise exceptions with messages
|
||||
|
||||
2009-06-22 Matthew Gingell <gingell@adacore.com>
|
||||
|
||||
* adaint.h: Complete previous change.
|
||||
|
||||
2009-06-22 Thomas Quinot <quinot@adacore.com>
|
||||
|
||||
* exp_ch7.ads, exp_ch3.adb: Minor reformatting
|
||||
|
||||
2009-06-22 Ed Schonberg <schonberg@adacore.com>
|
||||
|
||||
* sem_ch6.adb (Check_Overriding_Indicator): When style checks are
|
||||
enabled, emit warning when a non-controlling argument of the overriding
|
||||
operation appears out of place vis-a-vis of the formal of the
|
||||
overridden operation.
|
||||
|
||||
2009-06-22 Vincent Celier <celier@adacore.com>
|
||||
|
||||
* gnatcmd.adb (Check_Files): Close temporary files after all file names
|
||||
|
|
|
|||
|
|
@ -58,6 +58,7 @@
|
|||
#define FOPEN fopen
|
||||
#define STAT stat
|
||||
#define FSTAT fstat
|
||||
#define LSTAT lstat
|
||||
#define STRUCT_STAT struct stat
|
||||
#endif
|
||||
|
||||
|
|
|
|||
|
|
@ -1854,7 +1854,7 @@ package body Exp_Ch3 is
|
|||
-- Take a copy of Exp to ensure that later copies of this component
|
||||
-- declaration in derived types see the original tree, not a node
|
||||
-- rewritten during expansion of the init_proc. If the copy contains
|
||||
-- itypes, the scope of the new itypes is the init.proc being built.
|
||||
-- itypes, the scope of the new itypes is the init_proc being built.
|
||||
|
||||
Exp := New_Copy_Tree (Exp, New_Scope => Proc_Id);
|
||||
|
||||
|
|
@ -1885,7 +1885,7 @@ package body Exp_Ch3 is
|
|||
end if;
|
||||
|
||||
-- Adjust the component if controlled except if it is an aggregate
|
||||
-- that will be expanded inline
|
||||
-- that will be expanded inline.
|
||||
|
||||
if Kind = N_Qualified_Expression then
|
||||
Kind := Nkind (Expression (N));
|
||||
|
|
|
|||
|
|
@ -6,7 +6,7 @@
|
|||
-- --
|
||||
-- S p e c --
|
||||
-- --
|
||||
-- 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- --
|
||||
|
|
@ -75,8 +75,8 @@ package Exp_Ch7 is
|
|||
-- E is an entity representing a controlled object, a controlled type or a
|
||||
-- scope. If Ref is not empty, it is a reference to a controlled record,
|
||||
-- the closest Final list is in the controller component of the record
|
||||
-- containing Ref otherwise this function returns a reference to the final
|
||||
-- list attached to the closest dynamic scope (that can be E itself)
|
||||
-- containing Ref, otherwise this function returns a reference to the final
|
||||
-- list attached to the closest dynamic scope (which can be E itself),
|
||||
-- creating this final list if necessary.
|
||||
|
||||
function Has_New_Controlled_Component (E : Entity_Id) return Boolean;
|
||||
|
|
|
|||
|
|
@ -2451,7 +2451,7 @@ package body Freeze is
|
|||
and then Convention (E) = Convention_C
|
||||
then
|
||||
Error_Msg_N
|
||||
("?& is a tagged type which does not "
|
||||
("?& involves a tagged type which does not "
|
||||
& "correspond to any C type!", Formal);
|
||||
|
||||
-- Check wrong convention subprogram pointer
|
||||
|
|
@ -2600,15 +2600,30 @@ package body Freeze is
|
|||
end if;
|
||||
end if;
|
||||
|
||||
-- VM functions returning unconstrained arrays are
|
||||
-- correctly handled with the .NET/JVM compilers. Don't
|
||||
-- display this warning in those cases.
|
||||
-- Give warning for suspicous return of a result of an
|
||||
-- unconstrained array type in a foreign convention
|
||||
-- function.
|
||||
|
||||
if Is_Array_Type (R_Type)
|
||||
if Has_Foreign_Convention (E)
|
||||
|
||||
-- We are looking for a return of unconstrained array
|
||||
|
||||
and then Is_Array_Type (R_Type)
|
||||
and then not Is_Constrained (R_Type)
|
||||
|
||||
-- Exclude imported routines, the warning does not
|
||||
-- belong on the import, but on the routine definition.
|
||||
|
||||
and then not Is_Imported (E)
|
||||
|
||||
-- Exclude VM case, since both .NET and JVM can handle
|
||||
-- return of unconstrained arrays without a problem.
|
||||
|
||||
and then VM_Target = No_VM
|
||||
and then Has_Foreign_Convention (E)
|
||||
|
||||
-- Check that general warning is enabled, and that it
|
||||
-- is not suppressed for this particular case.
|
||||
|
||||
and then Warn_On_Export_Import
|
||||
and then not Has_Warnings_Off (E)
|
||||
and then not Has_Warnings_Off (R_Type)
|
||||
|
|
@ -5047,14 +5062,24 @@ package body Freeze is
|
|||
elsif Is_Generic_Type (Etype (E)) then
|
||||
null;
|
||||
|
||||
-- VM functions returning unconstrained arrays are
|
||||
-- correctly handled with the .NET/JVM compilers. Don't
|
||||
-- display this warning in those cases.
|
||||
-- Display warning if returning unconstrained array
|
||||
|
||||
elsif Is_Array_Type (Retype)
|
||||
and then not Is_Constrained (Retype)
|
||||
|
||||
-- Exclude cases where descriptor mechanism is set, since the
|
||||
-- VMS descriptor mechanisms allow such unconstrained returns.
|
||||
|
||||
and then Mechanism (E) not in Descriptor_Codes
|
||||
|
||||
-- Check appropriate warning is enabled (should we check for
|
||||
-- Warnings (Off) on specific entities here, probably so???)
|
||||
|
||||
and then Warn_On_Export_Import
|
||||
|
||||
-- Exclude the VM case, since return of unconstrained arrays
|
||||
-- is properly handled in both the JVM and .NET cases.
|
||||
|
||||
and then VM_Target = No_VM
|
||||
then
|
||||
Error_Msg_N
|
||||
|
|
@ -5084,9 +5109,9 @@ package body Freeze is
|
|||
end if;
|
||||
end if;
|
||||
|
||||
-- For VMS, descriptor mechanisms for parameters are allowed only
|
||||
-- for imported/exported subprograms. Moreover, the NCA descriptor
|
||||
-- is not allowed for parameters of exported subprograms.
|
||||
-- For VMS, descriptor mechanisms for parameters are allowed only for
|
||||
-- imported/exported subprograms. Moreover, the NCA descriptor is not
|
||||
-- allowed for parameters of exported subprograms.
|
||||
|
||||
if OpenVMS_On_Target then
|
||||
if Is_Exported (E) then
|
||||
|
|
|
|||
|
|
@ -89,6 +89,10 @@ package body System.Val_Real is
|
|||
-- necessarily required in a case like this where the result is not
|
||||
-- a machine number, but it is certainly a desirable behavior.
|
||||
|
||||
procedure Bad_Based_Value;
|
||||
pragma No_Return (Bad_Based_Value);
|
||||
-- Raise exception for bad based value
|
||||
|
||||
procedure Scanf;
|
||||
-- Scans integer literal value starting at current character position.
|
||||
-- For each digit encountered, Uval is multiplied by 10.0, and the new
|
||||
|
|
@ -98,6 +102,16 @@ package body System.Val_Real is
|
|||
-- return P points past the last character. On entry, the current
|
||||
-- character is known to be a digit, so a numeral is definitely present.
|
||||
|
||||
---------------------
|
||||
-- Bad_Based_Value --
|
||||
---------------------
|
||||
|
||||
procedure Bad_Based_Value is
|
||||
begin
|
||||
raise Constraint_Error with
|
||||
"invalid based literal for 'Value";
|
||||
end Bad_Based_Value;
|
||||
|
||||
-----------
|
||||
-- Scanf --
|
||||
-----------
|
||||
|
|
@ -181,7 +195,8 @@ package body System.Val_Real is
|
|||
-- Any other initial character is an error
|
||||
|
||||
else
|
||||
raise Constraint_Error;
|
||||
raise Constraint_Error with
|
||||
"invalid character in 'Value string";
|
||||
end if;
|
||||
|
||||
-- Deal with based case
|
||||
|
|
@ -219,7 +234,7 @@ package body System.Val_Real is
|
|||
|
||||
loop
|
||||
if P > Max then
|
||||
raise Constraint_Error;
|
||||
Bad_Based_Value;
|
||||
|
||||
elsif Str (P) in Digs then
|
||||
Digit := Character'Pos (Str (P)) - Character'Pos ('0');
|
||||
|
|
@ -233,7 +248,7 @@ package body System.Val_Real is
|
|||
Character'Pos (Str (P)) - (Character'Pos ('a') - 10);
|
||||
|
||||
else
|
||||
raise Constraint_Error;
|
||||
Bad_Based_Value;
|
||||
end if;
|
||||
|
||||
-- Save up trailing zeroes after the decimal point
|
||||
|
|
@ -267,7 +282,7 @@ package body System.Val_Real is
|
|||
P := P + 1;
|
||||
|
||||
if P > Max then
|
||||
raise Constraint_Error;
|
||||
Bad_Based_Value;
|
||||
|
||||
elsif Str (P) = '_' then
|
||||
Scan_Underscore (Str, P, Ptr, Max, True);
|
||||
|
|
@ -282,7 +297,7 @@ package body System.Val_Real is
|
|||
After_Point := 1;
|
||||
|
||||
if P > Max then
|
||||
raise Constraint_Error;
|
||||
Bad_Based_Value;
|
||||
end if;
|
||||
end if;
|
||||
|
||||
|
|
@ -358,7 +373,7 @@ package body System.Val_Real is
|
|||
-- Here is where we check for a bad based number
|
||||
|
||||
if Bad_Base then
|
||||
raise Constraint_Error;
|
||||
Bad_Based_Value;
|
||||
|
||||
-- If OK, then deal with initial minus sign, note that this processing
|
||||
-- is done even if Uval is zero, so that -0.0 is correctly interpreted.
|
||||
|
|
|
|||
|
|
@ -4374,6 +4374,48 @@ package body Sem_Ch6 is
|
|||
return;
|
||||
end if;
|
||||
|
||||
-- The overriding operation is type conformant with the overridden one,
|
||||
-- but the names of the formals are not required to match. If the names
|
||||
-- appear permuted in the overriding operation this is a possible
|
||||
-- source of confusion that is worth diagnosing. Controlling formals
|
||||
-- often carry names that reflect the type, and it is not worthwhile
|
||||
-- requiring that their names match.
|
||||
|
||||
if Style_Check
|
||||
and then Present (Overridden_Subp)
|
||||
and then Nkind (Subp) /= N_Defining_Operator_Symbol
|
||||
then
|
||||
declare
|
||||
Form1 : Entity_Id;
|
||||
Form2 : Entity_Id;
|
||||
|
||||
begin
|
||||
Form1 := First_Formal (Subp);
|
||||
Form2 := First_Formal (Overridden_Subp);
|
||||
|
||||
if Present (Form1) then
|
||||
Form1 := Next_Formal (Form1);
|
||||
Form2 := Next_Formal (Form2);
|
||||
end if;
|
||||
|
||||
while Present (Form1) loop
|
||||
if not Is_Controlling_Formal (Form1)
|
||||
and then Present (Next_Formal (Form2))
|
||||
and then Chars (Form1) = Chars (Next_Formal (Form2))
|
||||
then
|
||||
Error_Msg_Node_2 := Alias (Overridden_Subp);
|
||||
Error_Msg_Sloc := Sloc (Error_Msg_Node_2);
|
||||
Error_Msg_NE ("& does not match corresponding formal of&#",
|
||||
Form1, Form1);
|
||||
exit;
|
||||
end if;
|
||||
|
||||
Next_Formal (Form1);
|
||||
Next_Formal (Form2);
|
||||
end loop;
|
||||
end;
|
||||
end if;
|
||||
|
||||
if Present (Overridden_Subp) then
|
||||
if Must_Not_Override (Spec) then
|
||||
Error_Msg_Sloc := Sloc (Overridden_Subp);
|
||||
|
|
|
|||
|
|
@ -37,7 +37,6 @@ 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;
|
||||
|
||||
|
|
@ -240,246 +239,6 @@ package body Sinput is
|
|||
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);
|
||||
|
||||
-- Skip past parens
|
||||
|
||||
-- This is not right, it does not deal with skipping comments
|
||||
-- and probably also has wide character problems ???
|
||||
|
||||
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 token, 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);
|
||||
|
||||
-- Now we have two tasks, first we are pointing to the start
|
||||
-- of the token below, second, we need to skip parentheses.
|
||||
|
||||
-- Skipping to the end of a token is not easy, we can't just
|
||||
-- skip to a space, since we may have e.g. X*YAR+Z, and if we
|
||||
-- are finding the end of the subexpression X*YAR, we don't
|
||||
-- want to skip past the +Z. Also we have to worry about
|
||||
-- skipping comments, and about wide characters ???
|
||||
|
||||
declare
|
||||
SFI : constant Source_File_Index :=
|
||||
Get_Source_File_Index (Loc);
|
||||
Src : constant Source_Buffer_Ptr := Source_Text (SFI);
|
||||
Lst : constant Source_Ptr := Source_Last (SFI);
|
||||
|
||||
begin
|
||||
-- Scan through first blank character, to get to the end
|
||||
-- of this token. As noted above that's not really right???
|
||||
|
||||
loop
|
||||
exit when Loc = Lst or else Src (Loc + 1) <= ' ';
|
||||
Loc := Loc + 1;
|
||||
end loop;
|
||||
|
||||
-- Skip past parens, but this also ignores comments ???
|
||||
|
||||
if Count > 0 then
|
||||
for J in 1 .. Count loop
|
||||
loop
|
||||
exit when Loc = Lst;
|
||||
Loc := Loc + 1;
|
||||
exit when Src (Loc) >= ' ';
|
||||
end loop;
|
||||
|
||||
exit when Src (Loc) /= ')';
|
||||
end loop;
|
||||
end if;
|
||||
end;
|
||||
|
||||
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 --
|
||||
-----------------------
|
||||
|
|
@ -525,8 +284,7 @@ package body Sinput is
|
|||
-----------------------------
|
||||
|
||||
function Get_Logical_Line_Number
|
||||
(P : Source_Ptr)
|
||||
return Logical_Line_Number
|
||||
(P : Source_Ptr) return Logical_Line_Number
|
||||
is
|
||||
SFR : Source_File_Record
|
||||
renames Source_File.Table (Get_Source_File_Index (P));
|
||||
|
|
@ -546,8 +304,7 @@ package body Sinput is
|
|||
------------------------------
|
||||
|
||||
function Get_Physical_Line_Number
|
||||
(P : Source_Ptr)
|
||||
return Physical_Line_Number
|
||||
(P : Source_Ptr) return Physical_Line_Number
|
||||
is
|
||||
Sfile : Source_File_Index;
|
||||
Table : Lines_Table_Ptr;
|
||||
|
|
@ -711,7 +468,6 @@ package body Sinput is
|
|||
|
||||
begin
|
||||
S := P;
|
||||
|
||||
while S > Sfirst
|
||||
and then Src (S - 1) /= CR
|
||||
and then Src (S - 1) /= LF
|
||||
|
|
@ -723,9 +479,8 @@ package body Sinput is
|
|||
end Line_Start;
|
||||
|
||||
function Line_Start
|
||||
(L : Physical_Line_Number;
|
||||
S : Source_File_Index)
|
||||
return Source_Ptr
|
||||
(L : Physical_Line_Number;
|
||||
S : Source_File_Index) return Source_Ptr
|
||||
is
|
||||
begin
|
||||
return Source_File.Table (S).Lines_Table (L);
|
||||
|
|
@ -794,8 +549,7 @@ package body Sinput is
|
|||
|
||||
function Physical_To_Logical
|
||||
(Line : Physical_Line_Number;
|
||||
S : Source_File_Index)
|
||||
return Logical_Line_Number
|
||||
S : Source_File_Index) return Logical_Line_Number
|
||||
is
|
||||
SFR : Source_File_Record renames Source_File.Table (S);
|
||||
|
||||
|
|
@ -935,6 +689,44 @@ package body Sinput is
|
|||
end;
|
||||
end Skip_Line_Terminators;
|
||||
|
||||
----------------
|
||||
-- Sloc_Range --
|
||||
----------------
|
||||
|
||||
procedure Sloc_Range (Expr : Node_Id; Min, Max : out Source_Ptr) is
|
||||
|
||||
function Process (N : Node_Id) return Traverse_Result;
|
||||
-- Process function for traversing the expression tree
|
||||
|
||||
procedure Traverse is new Traverse_Proc (Process);
|
||||
|
||||
-------------
|
||||
-- Process --
|
||||
-------------
|
||||
|
||||
function Process (N : Node_Id) return Traverse_Result is
|
||||
begin
|
||||
if Sloc (N) < Min then
|
||||
if Sloc (N) > No_Location then
|
||||
Min := Sloc (N);
|
||||
end if;
|
||||
elsif Sloc (N) > Max then
|
||||
if Sloc (N) > No_Location then
|
||||
Max := Sloc (N);
|
||||
end if;
|
||||
end if;
|
||||
|
||||
return OK;
|
||||
end Process;
|
||||
|
||||
-- Start of processing for Sloc_Range
|
||||
|
||||
begin
|
||||
Min := Sloc (Expr);
|
||||
Max := Sloc (Expr);
|
||||
Traverse (Expr);
|
||||
end Sloc_Range;
|
||||
|
||||
-------------------
|
||||
-- Source_Offset --
|
||||
-------------------
|
||||
|
|
@ -943,7 +735,6 @@ package body Sinput is
|
|||
Sindex : constant Source_File_Index := Get_Source_File_Index (S);
|
||||
Sfirst : constant Source_Ptr :=
|
||||
Source_File.Table (Sindex).Source_First;
|
||||
|
||||
begin
|
||||
return Nat (S - Sfirst);
|
||||
end Source_Offset;
|
||||
|
|
@ -1368,7 +1159,6 @@ package body Sinput is
|
|||
else
|
||||
return Source_File.Table (S).Source_Last;
|
||||
end if;
|
||||
|
||||
end Source_Last;
|
||||
|
||||
function Source_Text (S : SFI) return Source_Buffer_Ptr is
|
||||
|
|
@ -1378,7 +1168,6 @@ package body Sinput is
|
|||
else
|
||||
return Source_File.Table (S).Source_Text;
|
||||
end if;
|
||||
|
||||
end Source_Text;
|
||||
|
||||
function Template (S : SFI) return SFI is
|
||||
|
|
|
|||
|
|
@ -471,14 +471,6 @@ package Sinput is
|
|||
-- 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
|
||||
|
|
@ -571,12 +563,12 @@ package Sinput is
|
|||
procedure Skip_Line_Terminators
|
||||
(P : in out Source_Ptr;
|
||||
Physical : out Boolean);
|
||||
-- On entry, P points to a line terminator that has been encountered, which
|
||||
-- is one of FF,LF,VT,CR or a wide character sequence whose value is in
|
||||
-- category Separator,Line or Separator,Paragraph. P points just past the
|
||||
-- character that was scanned. The purpose of this routine is to
|
||||
-- distinguish physical and logical line endings. A physical line ending is
|
||||
-- one of:
|
||||
-- On entry, P points to a line terminator that has been encountered,
|
||||
-- which is one of FF,LF,VT,CR or a wide character sequence whose value is
|
||||
-- in category Separator,Line or Separator,Paragraph. P points just past
|
||||
-- the character that was scanned. The purpose of this routine is to
|
||||
-- distinguish physical and logical line endings. A physical line ending
|
||||
-- is one of:
|
||||
--
|
||||
-- CR on its own (MAC System 7)
|
||||
-- LF on its own (Unix and unix-like systems)
|
||||
|
|
@ -603,6 +595,15 @@ package Sinput is
|
|||
-- makes sure that the lines table for the current source file has an
|
||||
-- appropriate entry for the start of the new physical line.
|
||||
|
||||
procedure Sloc_Range (Expr : Node_Id; Min, Max : out Source_Ptr);
|
||||
-- Given a node for a subexpression, returns the minimum and maximum source
|
||||
-- locations of any node in the expression subtree. This is not quite the
|
||||
-- same as the locations of the first and last token in the expresion
|
||||
-- because parentheses at the outer level do not have a recorded Sloc.
|
||||
--
|
||||
-- Note: if the tree for the expression contains no "real" Sloc values,
|
||||
-- i.e. values > No_Location, then both Min and Max are set to Sloc (Expr).
|
||||
|
||||
function Source_Offset (S : Source_Ptr) return Nat;
|
||||
-- Returns the zero-origin offset of the given source location from the
|
||||
-- start of its corresponding unit. This is used for creating canonical
|
||||
|
|
|
|||
Loading…
Add table
Reference in a new issue