OpenE2K
/
gcc
2
0
Fork 0
Code Issues Pull Requests Projects Releases Wiki Activity

[multiple changes] 

2015-01-06  Robert Dewar  <dewar@adacore.com>

	* s-valint.adb, s-valuns.adb (Value_Integer): Deal with case where
	Str'Last = Positive'Last

2015-01-06  Thomas Quinot  <quinot@adacore.com>

	* xoscons.adb: Display exception information and return non-zero
	exit status in top level exception handler.

From-SVN: r219242
This commit is contained in:
Arnaud Charlet 2015-01-06 10:53:40 +01:00
parent fb153d02da
commit 8d1359c773
4 changed files with 47 additions and 12 deletions
Show Stats Download Patch File Download Diff File Expand all files Collapse all files

10
gcc/ada/ChangeLog
View File

@ -1,3 +1,13 @@
2015-01-06 Robert Dewar <dewar@adacore.com>
* s-valint.adb, s-valuns.adb (Value_Integer): Deal with case where
Str'Last = Positive'Last
2015-01-06 Thomas Quinot <quinot@adacore.com>
* xoscons.adb: Display exception information and return non-zero
exit status in top level exception handler.
2015-01-06 Ed Schonberg <schonberg@adacore.com>
* sem_ch8.adb: Code clean up.

30
gcc/ada/s-valint.adb
View File

@ -6,7 +6,7 @@
-- --
-- B o d y --
-- --
-- Copyright (C) 1992-2012, Free Software Foundation, Inc. --
-- Copyright (C) 1992-2014, 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- --
@ -89,12 +89,30 @@ package body System.Val_Int is
-------------------
function Value_Integer (Str : String) return Integer is
V : Integer;
P : aliased Integer := Str'First;
begin
V := Scan_Integer (Str, P'Access, Str'Last);
Scan_Trailing_Blanks (Str, P);
return V;
-- We have to special case Str'Last = Positive'Last because the normal
-- circuit ends up setting P to Str'Last + 1 which is out of bounds. We
-- deal with this by converting to a subtype which fixes the bounds.
if Str'Last = Positive'Last then
declare
subtype NT is String (1 .. Str'Length);
begin
return Value_Integer (NT (Str));
end;
-- Normal case where Str'Last < Positive'Last
else
declare
V : Integer;
P : aliased Integer := Str'First;
begin
V := Scan_Integer (Str, P'Access, Str'Length);
Scan_Trailing_Blanks (Str, P);
return V;
end;
end if;
end Value_Integer;
end System.Val_Int;

11
gcc/ada/s-valuns.adb
View File

@ -289,11 +289,16 @@ package body System.Val_Uns is
--------------------
function Value_Unsigned (Str : String) return Unsigned is
subtype NT is String (1 .. Str'Length);
-- We use this subtype to convert Str for the calls below to deal with
-- the obscure case where Str'Last is Positive'Last. Without these
-- conversions, such a case would raise Constraint_Error.
V : Unsigned;
P : aliased Integer := Str'First;
P : aliased Integer := 1;
begin
V := Scan_Unsigned (Str, P'Access, Str'Last);
Scan_Trailing_Blanks (Str, P);
V := Scan_Unsigned (NT (Str), P'Access, Str'Length);
Scan_Trailing_Blanks (NT (Str), P);
return V;
end Value_Unsigned;

8
gcc/ada/xoscons.adb
View File

@ -6,7 +6,7 @@
-- --
-- B o d y --
-- --
-- Copyright (C) 2008-2013, Free Software Foundation, Inc. --
-- Copyright (C) 2008-2014, 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- --
@ -47,6 +47,7 @@ pragma Warnings (Off);
with System.Unsigned_Types; use System.Unsigned_Types;
pragma Warnings (On);
with GNAT.OS_Lib;
with GNAT.String_Split; use GNAT.String_Split;
with GNAT.Table;
@ -700,6 +701,7 @@ begin
Close (Tmpl_File);
exception
when others =>
Put_Line ("xoscons <base_name>");
when E : others =>
Put_Line ("raised " & Ada.Exceptions.Exception_Information (E));
GNAT.OS_Lib.OS_Exit (1);
end XOSCons;