Commit ef25192b by Yannick Moy Committed by Arnaud Charlet

a-tigeli.adb (Get_Line): Always set Last prior to returning.

2016-05-02  Yannick Moy  <moy@adacore.com>

	* a-tigeli.adb (Get_Line): Always set Last prior to returning.

2016-05-02  Yannick Moy  <moy@adacore.com>

	* lib-xref.adb: Minor style fix in whitespace of declarations.
	* put_spark_xrefs.adb (Put_SPARK_Xrefs): printing of strings
	refactored without loops.
	* put_spark_xrefs.ads (Write_Info_Str): new formal argument of
	generic procedure.
	* spark_xrefs.adb (Write_Info_Str): new actual in instantiation
	of generic procedure.

From-SVN: r235728
parent ebae28e9
2016-05-02 Yannick Moy <moy@adacore.com>
* a-tigeli.adb (Get_Line): Always set Last prior to returning.
2016-05-02 Yannick Moy <moy@adacore.com>
* lib-xref.adb: Minor style fix in whitespace of declarations.
* put_spark_xrefs.adb (Put_SPARK_Xrefs): printing of strings
refactored without loops.
* put_spark_xrefs.ads (Write_Info_Str): new formal argument of
generic procedure.
* spark_xrefs.adb (Write_Info_Str): new actual in instantiation
of generic procedure.
2016-05-02 Arnaud Charlet <charlet@adacore.com> 2016-05-02 Arnaud Charlet <charlet@adacore.com>
* lib-xref-spark_specific.adb (Add_SPARK_Scope): add task type scope. * lib-xref-spark_specific.adb (Add_SPARK_Scope): add task type scope.
......
...@@ -150,6 +150,12 @@ is ...@@ -150,6 +150,12 @@ is
begin begin
FIO.Check_Read_Status (AP (File)); FIO.Check_Read_Status (AP (File));
-- Set Last to Item'First - 1 when no characters are read, as mandated by
-- Ada RM. In the case where Item'First is negative or null, this results
-- in Constraint_Error being raised.
Last := Item'First - 1;
-- Immediate exit for null string, this is a case in which we do not -- Immediate exit for null string, this is a case in which we do not
-- need to test for end of file and we do not skip a line mark under -- need to test for end of file and we do not skip a line mark under
-- any circumstances. -- any circumstances.
...@@ -160,8 +166,6 @@ begin ...@@ -160,8 +166,6 @@ begin
N := Item'Last - Item'First + 1; N := Item'Last - Item'First + 1;
Last := Item'First - 1;
-- Here we have at least one character, if we are immediately before -- Here we have at least one character, if we are immediately before
-- a line mark, then we will just skip past it storing no characters. -- a line mark, then we will just skip past it storing no characters.
......
...@@ -191,8 +191,7 @@ package body Lib.Xref is ...@@ -191,8 +191,7 @@ package body Lib.Xref is
Set_Has_Xref_Entry (Key.Ent); Set_Has_Xref_Entry (Key.Ent);
-- It was already in Xref_Set, so throw away the tentatively-added -- It was already in Xref_Set, so throw away the tentatively-added entry
-- entry.
else else
Xrefs.Decrement_Last; Xrefs.Decrement_Last;
...@@ -373,16 +372,16 @@ package body Lib.Xref is ...@@ -373,16 +372,16 @@ package body Lib.Xref is
Set_Ref : Boolean := True; Set_Ref : Boolean := True;
Force : Boolean := False) Force : Boolean := False)
is is
Actual_Typ : Character := Typ; Actual_Typ : Character := Typ;
Call : Node_Id; Call : Node_Id;
Def : Source_Ptr; Def : Source_Ptr;
Ent : Entity_Id; Ent : Entity_Id;
Ent_Scope : Entity_Id; Ent_Scope : Entity_Id;
Formal : Entity_Id; Formal : Entity_Id;
Kind : Entity_Kind; Kind : Entity_Kind;
Nod : Node_Id; Nod : Node_Id;
Ref : Source_Ptr; Ref : Source_Ptr;
Ref_Scope : Entity_Id; Ref_Scope : Entity_Id;
function Get_Through_Renamings (E : Entity_Id) return Entity_Id; function Get_Through_Renamings (E : Entity_Id) return Entity_Id;
-- Get the enclosing entity through renamings, which may come from -- Get the enclosing entity through renamings, which may come from
......
...@@ -6,7 +6,7 @@ ...@@ -6,7 +6,7 @@
-- -- -- --
-- S p e c -- -- S p e c --
-- -- -- --
-- Copyright (C) 2011-2013, Free Software Foundation, Inc. -- -- Copyright (C) 2011-2016, 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- --
...@@ -43,6 +43,9 @@ generic ...@@ -43,6 +43,9 @@ generic
with procedure Write_Info_Char (C : Character) is <>; with procedure Write_Info_Char (C : Character) is <>;
-- Output one character -- Output one character
with procedure Write_Info_Str (Val : String) is <>;
-- Output string stored in string pointer
with procedure Write_Info_Initiate (Key : Character) is <>; with procedure Write_Info_Initiate (Key : Character) is <>;
-- Initiate write of new line to output file, the parameter is the -- Initiate write of new line to output file, the parameter is the
-- keyword character for the line. -- keyword character for the line.
......
...@@ -6,7 +6,7 @@ ...@@ -6,7 +6,7 @@
-- -- -- --
-- B o d y -- -- B o d y --
-- -- -- --
-- Copyright (C) 2011-2013, Free Software Foundation, Inc. -- -- Copyright (C) 2011-2016, 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- --
...@@ -160,7 +160,10 @@ package body SPARK_Xrefs is ...@@ -160,7 +160,10 @@ package body SPARK_Xrefs is
procedure pspark is procedure pspark is
procedure Write_Info_Char (C : Character) renames Write_Char; procedure Write_Info_Char (C : Character) renames Write_Char;
-- Write one character; -- Write one character
procedure Write_Info_Str (Val : String) renames Write_Str;
-- Write string
function Write_Info_Col return Positive; function Write_Info_Col return Positive;
-- Return next column for writing -- Return next column for writing
......
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