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
System.Case_Util
(Canonical_Case_Env_Var_Name): Ditto
-- --
-- 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- --
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;
-----------
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;
-------------
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;
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");
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.
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
-- 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
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).
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;
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;
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;
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",
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;
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;
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.
-- --
-- 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- --
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;
-----------
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;
----------
-- --
-- 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- --
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;
("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);
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,
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 --
-----------------------------
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);
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;
-- 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
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)
-- --
-- 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- --
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;
OSDN Git Service
