procyberian/gcc
1
0
Fork 0
Code Issues Pull requests Projects Releases Packages Wiki Activity Actions

[multiple changes]

Browse source 
2010-09-09  Vincent Celier  <celier@adacore.com>

	* prj-proc.adb: Minor comment spelling error fix.
	* osint.ads (Env_Vars_Case_Sensitive): Use function
	Get_Env_Vars_Case_Sensitive, not Get_File_Names_Case_Sensitive to
	compute value.

2010-09-09  Ed Schonberg  <schonberg@adacore.com>

	* sem_res.adb (Resolve_Equality_Op): Implement Ada2012 rule for
	resolution of conditional expressions whose dependent expressions are
	anonymous access types.

2010-09-09  Robert Dewar  <dewar@adacore.com>

	* a-ststio.adb: Minor code reorganization.
	* s-direio.adb, prj.adb, prj-nmsc.adb, sem_type.adb: Remove redundant
	conversion.
	* types.ads: Minor reformatting.
	* binde.adb, vms_conv.adb, gnatls.adb, s-strxdr.adb, uintp.adb: Remove
	redundant conversions.
	* output.adb: Minor reformatting.
	* sem_ch8.adb (Find_Type): Test for redundant base applies to user
	types.
	* opt.ads: Add pragma Ordered for Verbosity_Level.
	* prj.ads: Add pragma Ordered for type Verbosity.

From-SVN: r164072
This commit is contained in:
Arnaud Charlet 2010-09-09 12:39:19 +02:00
parent d2795d5831
commit a8930b8052
19 changed files with 119 additions and 55 deletions
Show stats Download patch file Download diff file Expand all files Collapse all files

27
gcc/ada/ChangeLog
View file

@ -1,3 +1,30 @@
2010-09-09 Vincent Celier <celier@adacore.com>
* prj-proc.adb: Minor comment spelling error fix.
* osint.ads (Env_Vars_Case_Sensitive): Use function
Get_Env_Vars_Case_Sensitive, not Get_File_Names_Case_Sensitive to
compute value.
2010-09-09 Ed Schonberg <schonberg@adacore.com>
* sem_res.adb (Resolve_Equality_Op): Implement Ada2012 rule for
resolution of conditional expressions whose dependent expressions are
anonymous access types.
2010-09-09 Robert Dewar <dewar@adacore.com>
* a-ststio.adb: Minor code reorganization.
* s-direio.adb, prj.adb, prj-nmsc.adb, sem_type.adb: Remove redundant
conversion.
* types.ads: Minor reformatting.
* binde.adb, vms_conv.adb, gnatls.adb, s-strxdr.adb, uintp.adb: Remove
redundant conversions.
* output.adb: Minor reformatting.
* sem_ch8.adb (Find_Type): Test for redundant base applies to user
types.
* opt.ads: Add pragma Ordered for Verbosity_Level.
* prj.ads: Add pragma Ordered for type Verbosity.
2010-09-09 Vincent Celier <celier@adacore.com>
* osint.adb (Canonical_Case_File_Name): Use procedure To_Lower in

6
gcc/ada/a-ststio.adb
View file

@ -6,7 +6,7 @@
-- --
-- B o d y --
-- --
-- Copyright (C) 1992-2009, Free Software Foundation, Inc. --
-- Copyright (C) 1992-2010, 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- --
@ -147,7 +147,7 @@ package body Ada.Streams.Stream_IO is
function End_Of_File (File : File_Type) return Boolean is
begin
FIO.Check_Read_Status (AP (File));
return Count (File.Index) > Size (File);
return File.Index > Size (File);
end End_Of_File;
-----------
@ -175,7 +175,7 @@ package body Ada.Streams.Stream_IO is
function Index (File : File_Type) return Positive_Count is
begin
FIO.Check_File_Open (AP (File));
return Count (File.Index);
return File.Index;
end Index;
-------------

7
gcc/ada/binde.adb
View file

@ -614,7 +614,7 @@ package body Binde is
Write_Str (" decrementing Num_Pred for unit ");
Write_Unit_Name (Units.Table (U).Uname);
Write_Str (" new value = ");
Write_Int (Int (UNR.Table (U).Num_Pred));
Write_Int (UNR.Table (U).Num_Pred);
Write_Eol;
end if;
@ -1152,7 +1152,7 @@ package body Binde is
Write_Str
(" Elaborate_Body = True, Num_Pred for body = ");
Write_Int
(Int (UNR.Table (Corresponding_Body (U)).Num_Pred));
(UNR.Table (Corresponding_Body (U)).Num_Pred);
else
Write_Str
(" Elaborate_Body = False");
@ -1243,8 +1243,7 @@ package body Binde is
goto Next_With;
end if;
Withed_Unit :=
Unit_Id (Unit_Id_Of (Withs.Table (W).Uname));
Withed_Unit := Unit_Id_Of (Withs.Table (W).Uname);
-- Pragma Elaborate_All case, for this we use the recursive
-- Elab_All_Links procedure to establish the links.

10
gcc/ada/gnatls.adb
View file

@ -1362,13 +1362,11 @@ procedure Gnatls is
declare
Src_Path_Name : constant String_Ptr :=
String_Ptr
(Get_RTS_Search_Dir
(Argv (7 .. Argv'Last), Include));
Get_RTS_Search_Dir
(Argv (7 .. Argv'Last), Include);
Lib_Path_Name : constant String_Ptr :=
String_Ptr
(Get_RTS_Search_Dir
(Argv (7 .. Argv'Last), Objects));
Get_RTS_Search_Dir
(Argv (7 .. Argv'Last), Objects);
begin
if Src_Path_Name /= null

1
gcc/ada/opt.ads
View file

@ -1306,6 +1306,7 @@ package Opt is
-- information sent to standard output, also header, copyright and summary)
type Verbosity_Level_Type is (None, Low, Medium, High);
pragma Ordered (Verbosity_Level_Type);
Verbosity_Level : Verbosity_Level_Type := High;
-- GNATMAKE, GPRMAKE
-- Modified by gnatmake or gprmake switches -v, -vl, -vm, -vh. Indicates

2
gcc/ada/osint.ads
View file

@ -98,7 +98,7 @@ package Osint is
pragma Import (C, Get_Env_Vars_Case_Sensitive,
"__gnat_get_env_vars_case_sensitive");
Env_Vars_Case_Sensitive : constant Boolean :=
Get_File_Names_Case_Sensitive /= 0;
Get_Env_Vars_Case_Sensitive /= 0;
-- Set to indicate whether the operating system convention is for
-- environment variable names to be case sensitive (e.g., in Unix, set
-- True), or non case sensitive (e.g., in Windows, set False).

12
gcc/ada/output.adb
View file

@ -129,8 +129,9 @@ package body Output is
else
declare
Indented_Buffer : constant String
:= (1 .. Cur_Indentation => ' ') & Buffer (1 .. Len);
Indented_Buffer : constant String :=
(1 .. Cur_Indentation => ' ') &
Buffer (1 .. Len);
begin
Write_Buffer (Indented_Buffer);
end;
@ -138,9 +139,10 @@ package body Output is
exception
when Write_Error =>
-- If there are errors with standard error, just quit.
-- Otherwise, set the output to standard error before reporting
-- a failure and quitting.
-- If there are errors with standard error just quit. Otherwise
-- set the output to standard error before reporting a failure
-- and quitting.
if Current_FD /= Standerr then
Current_FD := Standerr;

4
gcc/ada/prj-nmsc.adb
View file

@ -5505,7 +5505,7 @@ package body Prj.Nmsc is
Element := Data.Tree.String_Elements.Table (Current);
if Element.Value /= No_Name then
Element.Value :=
Name_Id (Canonical_Case_File_Name (Name_Id (Element.Value)));
Name_Id (Canonical_Case_File_Name (Element.Value));
Data.Tree.String_Elements.Table (Current) := Element;
end if;
@ -6519,7 +6519,7 @@ package body Prj.Nmsc is
if not Found then
Error_Msg_Name_1 := Name_Id (Source.Display_File);
Error_Msg_Name_2 := Name_Id (Source.Unit.Name);
Error_Msg_Name_2 := Source.Unit.Name;
Error_Or_Warning
(Data.Flags, Data.Flags.Missing_Source_Files,
"source file %% for unit %% not found",

2
gcc/ada/prj-proc.adb
View file

@ -346,7 +346,7 @@ package body Prj.Proc is
Var := In_Tree.Variable_Elements.Table (V1);
V1 := Var.Next;
-- Do not copy the value of attribute inker_Options if Restricted
-- Do not copy the value of attribute Linker_Options if Restricted
if Restricted and then Var.Name = Snames.Name_Linker_Options then
Var.Value.Values := Nil_String;

10
gcc/ada/prj.adb
View file

@ -247,16 +247,10 @@ package body Prj is
return No_File;
when Makefile =>
return
File_Name_Type
(Extend_Name
(Source_File_Name, Makefile_Dependency_Suffix));
return Extend_Name (Source_File_Name, Makefile_Dependency_Suffix);
when ALI_File =>
return
File_Name_Type
(Extend_Name
(Source_File_Name, ALI_Dependency_Suffix));
return Extend_Name (Source_File_Name, ALI_Dependency_Suffix);
end case;
end Dependency_Name;

1
gcc/ada/prj.ads
View file

@ -820,6 +820,7 @@ package Prj is
Equal => "=");
type Verbosity is (Default, Medium, High);
pragma Ordered (Verbosity);
-- Verbosity when parsing GNAT Project Files
-- Default is default (very quiet, if no errors).
-- Medium is more verbose.

6
gcc/ada/s-direio.adb
View file

@ -6,7 +6,7 @@
-- --
-- B o d y --
-- --
-- Copyright (C) 1992-2009, Free Software Foundation, Inc. --
-- Copyright (C) 1992-2010, 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- --
@ -127,7 +127,7 @@ package body System.Direct_IO is
function End_Of_File (File : File_Type) return Boolean is
begin
FIO.Check_Read_Status (AP (File));
return Count (File.Index) > Size (File);
return File.Index > Size (File);
end End_Of_File;
-----------
@ -137,7 +137,7 @@ package body System.Direct_IO is
function Index (File : File_Type) return Positive_Count is
begin
FIO.Check_File_Open (AP (File));
return Count (File.Index);
return File.Index;
end Index;
----------

4
gcc/ada/s-strxdr.adb
View file

@ -6,7 +6,7 @@
-- --
-- B o d y --
-- --
-- Copyright (C) 1996-2009, Free Software Foundation, Inc. --
-- Copyright (C) 1996-2010, Free Software Foundation, Inc. --
-- --
-- GARLIC 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- --
@ -1466,7 +1466,7 @@ package body System.Stream_Attributes is
Exponent := Long_Unsigned (E + E_Bias);
F := Long_Long_Float'Scaling (F, F_Size - HFS);
Fraction_1 := Long_Long_Unsigned (Long_Long_Float'Floor (F));
F := Long_Long_Float (F - Long_Long_Float (Fraction_1));
F := F - Long_Long_Float (Fraction_1);
F := Long_Long_Float'Scaling (F, HFS);
Fraction_2 := Long_Long_Unsigned (Long_Long_Float'Floor (F));
end if;

7
gcc/ada/sem_ch8.adb
View file

@ -5766,9 +5766,8 @@ package body Sem_Ch8 is
("prefix of Base attribute must be scalar type",
Prefix (N));
elsif Sloc (Typ) = Standard_Location
elsif Warn_On_Redundant_Constructs
and then Base_Type (Typ) = Typ
and then Warn_On_Redundant_Constructs
then
Error_Msg_NE -- CODEFIX
("?redundant attribute, & is its own base type", N, Typ);
@ -5777,8 +5776,8 @@ package body Sem_Ch8 is
T := Base_Type (Typ);
-- Rewrite attribute reference with type itself (see similar
-- processing in Analyze_Attribute, case Base). Preserve
-- prefix if present, for other legality checks.
-- processing in Analyze_Attribute, case Base). Preserve prefix
-- if present, for other legality checks.
if Nkind (Prefix (N)) = N_Expanded_Name then
Rewrite (N,

45
gcc/ada/sem_res.adb
View file

@ -6391,12 +6391,41 @@ package body Sem_Res is
R : constant Node_Id := Right_Opnd (N);
T : Entity_Id := Find_Unique_Type (L, R);
procedure Check_Conditional_Expression (Cond : Node_Id);
-- The resolution rule for conditional expressions requires that each
-- such must have a unique type. This means that if several dependent
-- expressions are of a non-null anonymous access type, and the context
-- does not impose an expected type (as can be the case in an equality
-- operation) the expression must be rejected.
function Find_Unique_Access_Type return Entity_Id;
-- In the case of allocators, make a last-ditch attempt to find a single
-- access type with the right designated type. This is semantically
-- dubious, and of no interest to any real code, but c48008a makes it
-- all worthwhile.
----------------------------------
-- Check_Conditional_Expression --
----------------------------------
procedure Check_Conditional_Expression (Cond : Node_Id) is
Then_Expr : Node_Id;
Else_Expr : Node_Id;
begin
if Nkind (Cond) = N_Conditional_Expression then
Then_Expr := Next (First (Expressions (Cond)));
Else_Expr := Next (Then_Expr);
if Nkind (Then_Expr) /= N_Null
and then Nkind (Else_Expr) /= N_Null
then
Error_Msg_N
("cannot determine type of conditional expression", Cond);
end if;
end if;
end Check_Conditional_Expression;
-----------------------------
-- Find_Unique_Access_Type --
-----------------------------
@ -6470,6 +6499,22 @@ package body Sem_Res is
Set_Etype (N, Any_Type);
return;
end if;
-- Conditional expressions must have a single type, and if the
-- context does not impose one the dependent expressions cannot
-- be anonymous access types.
elsif Ada_Version >= Ada_2012
and then Ekind_In (Etype (L),
E_Anonymous_Access_Type,
E_Anonymous_Access_Subprogram_Type)
and then Ekind_In (Etype (R),
E_Anonymous_Access_Type,
E_Anonymous_Access_Subprogram_Type)
then
Check_Conditional_Expression (L);
Check_Conditional_Expression (R);
end if;
Resolve (L, T);

2
gcc/ada/sem_type.adb
View file

@ -3222,7 +3222,7 @@ package body Sem_Type is
Write_Str (" Index: ");
Write_Int (Int (Interp_Map.Table (Map_Ptr).Index));
Write_Str (" Next: ");
Write_Int (Int (Interp_Map.Table (Map_Ptr).Next));
Write_Int (Interp_Map.Table (Map_Ptr).Next);
Write_Eol;
end Write_Interp_Ref;

14
gcc/ada/types.ads
View file

@ -251,13 +251,13 @@ package Types is
-- Universal integers (type Uint)
-- Universal reals (type Ureal)
-- In most contexts, the strongly typed interface determines which of
-- these types is present. However, there are some situations (involving
-- untyped traversals of the tree), where it is convenient to be easily
-- able to distinguish these values. The underlying representation in all
-- cases is an integer type Union_Id, and we ensure that the range of
-- the various possible values for each of the above types is disjoint
-- so that this distinction is possible.
-- In most contexts, the strongly typed interface determines which of these
-- types is present. However, there are some situations (involving untyped
-- traversals of the tree), where it is convenient to be easily able to
-- distinguish these values. The underlying representation in all cases is
-- an integer type Union_Id, and we ensure that the range of the various
-- possible values for each of the above types is disjoint so that this
-- distinction is possible.
type Union_Id is new Int;
-- The type in the tree for a union of possible ID values

4
gcc/ada/uintp.adb
View file

@ -2204,9 +2204,7 @@ package body Uintp is
and then
Int (Right) <= Int (Uint_Max_Simple_Mul)
then
return
UI_From_Int
(Int (Direct_Val (Left)) * Int (Direct_Val (Right)));
return UI_From_Int (Direct_Val (Left) * Direct_Val (Right));
end if;
-- Otherwise we have the general case (Algorithm M in Knuth)

10
gcc/ada/vms_conv.adb
View file

@ -6,7 +6,7 @@
-- --
-- B o d y --
-- --
-- Copyright (C) 1996-2009, Free Software Foundation, Inc. --
-- Copyright (C) 1996-2010, 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- --
@ -314,16 +314,16 @@ package body VMS_Conv is
loop
declare
Dir : constant String_Access :=
String_Access (Get_Next_Dir_In_Path (Object_Dir_Name));
Get_Next_Dir_In_Path (Object_Dir_Name);
begin
exit when Dir = null;
Object_Dirs := Object_Dirs + 1;
Object_Dir (Object_Dirs) :=
new String'("-L" &
To_Canonical_Dir_Spec
(To_Host_Dir_Spec
(Normalize_Directory_Name (Dir.all).all,
True).all, True).all);
(To_Host_Dir_Spec
(Normalize_Directory_Name (Dir.all).all,
True).all, True).all);
end;
end loop;