Skip to content

R
riscv-gcc-1
Commit 84157c9a by Robert Dewar Committed by Arnaud Charlet
Options

a-calend.adb: Minor code reorganization (use conditional expressions) 

2009-07-07  Robert Dewar  <dewar@adacore.com>

	* a-calend.adb: Minor code reorganization (use conditional expressions)

	* s-stusta.ads, s-interr-hwint.adb, g-expect-vms.adb, s-secsta.ads,
	prj-nmsc.adb, a-teioed.adb, output.ads, prj-attr.ads, a-textio.adb,
	s-taskin.ads, scans.ads, s-osinte-vms.adb, s-taprop-solaris.adb,
	s-tpopsp-posix-foreign.adb, s-trafor-default.adb, gnat1drv.adb,
	s-stchop-vxworks.adb, s-tpopsp-posix.adb, prj-env.adb, prj-env.ads,
	g-comlin.adb, exp_ch11.adb: Minor reformatting.

From-SVN: r149320
parent 535536b4
Showing with 160 additions and 133 deletions
gcc/ada/ChangeLog
2009-07-07 Robert Dewar <dewar@adacore.com>
* a-calend.adb: Minor code reorganization (use conditional expressions)
* s-stusta.ads, s-interr-hwint.adb, g-expect-vms.adb, s-secsta.ads,
prj-nmsc.adb, a-teioed.adb, output.ads, prj-attr.ads, a-textio.adb,
s-taskin.ads, scans.ads, s-osinte-vms.adb, s-taprop-solaris.adb,
s-tpopsp-posix-foreign.adb, s-trafor-default.adb, gnat1drv.adb,
s-stchop-vxworks.adb, s-tpopsp-posix.adb, prj-env.adb, prj-env.ads,
g-comlin.adb, exp_ch11.adb: Minor reformatting.
2009-07-07 Gary Dismukes <dismukes@adacore.com>
* checks.adb (Generate_Range_Check): Replace type conversions with
......
gcc/ada/a-calend.adb
......@@ -940,11 +940,7 @@ package body Ada.Calendar is
-- Step 3: Handle leap second occurrences
if Leap_Sec then
tm_sec := 60;
else
tm_sec := Second;
end if;
tm_sec := (if Leap_Sec then 60 else Second);
end To_Struct_Tm;
------------------
......@@ -1014,11 +1010,8 @@ package body Ada.Calendar is
-- the input. Guard against very large delay values such as the end
-- of time since the computation will overflow.
if Res_N > Safe_Ada_High then
Res_N := Safe_Ada_High;
else
Res_N := Res_N + Epoch_Offset;
end if;
Res_N := (if Res_N > Safe_Ada_High then Safe_Ada_High
else Res_N + Epoch_Offset);
return Time_Rep_To_Duration (Res_N);
end To_Duration;
......@@ -1495,7 +1488,7 @@ package body Ada.Calendar is
---------------------
function UTC_Time_Offset (Date : Time) return Long_Integer is
Adj_Cent : Integer := 0;
Adj_Cent : Integer;
Date_N : Time_Rep;
Offset : aliased long;
Secs_T : aliased time_t;
......@@ -1507,18 +1500,11 @@ package body Ada.Calendar is
-- saving and so on. Non-leap centennial years violate this rule by
-- one day and as a consequence, special adjustment is needed.
if Date_N > T_2100_2_28 then
if Date_N > T_2200_2_28 then
if Date_N > T_2300_2_28 then
Adj_Cent := 3;
else
Adj_Cent := 2;
end if;
else
Adj_Cent := 1;
end if;
end if;
Adj_Cent :=
(if Date_N <= T_2100_2_28 then 0
elsif Date_N <= T_2200_2_28 then 1
elsif Date_N <= T_2300_2_28 then 2
else 3);
if Adj_Cent > 0 then
Date_N := Date_N - Time_Rep (Adj_Cent) * Nanos_In_Day;
......
gcc/ada/a-teioed.adb
......@@ -306,14 +306,12 @@ package body Ada.Text_IO.Editing is
raise Ada.Text_IO.Layout_Error;
end if;
if Pic.Radix_Position = Invalid_Position then
Position := Answer'Last;
else
Position := Pic.Radix_Position - 1;
end if;
Position :=
(if Pic.Radix_Position = Invalid_Position
then Answer'Last
else Pic.Radix_Position - 1);
for J in reverse Attrs.Start_Of_Int .. Attrs.End_Of_Int loop
while Answer (Position) /= '9'
and Answer (Position) /= Pic.Floater
loop
......@@ -562,7 +560,6 @@ package body Ada.Text_IO.Editing is
Last := Pic.Radix_Position + 1;
for J in Last .. Answer'Last loop
if Answer (J) = '9' or Answer (J) = Pic.Floater then
Answer (J) := Rounded (Position);
......@@ -624,15 +621,13 @@ package body Ada.Text_IO.Editing is
-- No trailing digits, but now J may need to stick in a currency
-- symbol or sign.
if Pic.Start_Currency = Invalid_Position then
Position := Answer'Last + 1;
else
Position := Pic.Start_Currency;
end if;
Position :=
(if Pic.Start_Currency = Invalid_Position
then Answer'Last + 1
else Pic.Start_Currency);
end if;
for J in Position .. Answer'Last loop
if Pic.Start_Currency /= Invalid_Position and then
Answer (Pic.Start_Currency) = '#' then
Currency_Pos := 1;
......
gcc/ada/a-textio.adb
......@@ -562,13 +562,10 @@ package body Ada.Text_IO is
if ch = EOF then
raise End_Error;
else
if not Is_Start_Of_Encoding
(Character'Val (ch), File.WC_Method)
then
Item := Character'Val (ch);
else
Item := Get_Upper_Half_Char_Immed (Character'Val (ch), File);
end if;
Item :=
(if not Is_Start_Of_Encoding (Character'Val (ch), File.WC_Method)
then Character'Val (ch)
else Get_Upper_Half_Char_Immed (Character'Val (ch), File));
end if;
end if;
end Get_Immediate;
......@@ -625,13 +622,10 @@ package body Ada.Text_IO is
else
Available := True;
if Is_Start_Of_Encoding
(Character'Val (ch), File.WC_Method)
then
Item := Character'Val (ch);
else
Item := Get_Upper_Half_Char_Immed (Character'Val (ch), File);
end if;
Item :=
(if Is_Start_Of_Encoding (Character'Val (ch), File.WC_Method)
then Character'Val (ch)
else Get_Upper_Half_Char_Immed (Character'Val (ch), File));
end if;
end if;
......
gcc/ada/exp_ch11.adb
......@@ -1401,9 +1401,7 @@ package body Exp_Ch11 is
-- If a string expression is present, then the raise statement is
-- converted to a call:
-- Raise_Exception (exception-name'Identity, string);
-- and there is nothing else to do.
if Present (Expression (N)) then
......
gcc/ada/g-comlin.adb
......@@ -113,10 +113,10 @@ package body GNAT.Command_Line is
-- the beginning, else it is appended.
function Can_Have_Parameter (S : String) return Boolean;
-- True if S can have a parameter.
-- True if S can have a parameter
function Require_Parameter (S : String) return Boolean;
-- True if S requires a parameter.
-- True if S requires a parameter
function Actual_Switch (S : String) return String;
-- Remove any possible trailing '!', ':', '?' and '='
......
gcc/ada/g-expect-vms.adb
......@@ -1103,7 +1103,7 @@ package body GNAT.Expect is
-- currently we can cleanly close the unneeded ends of the pipes, but
-- this doesn't really matter.
-- We could close Pipe1.Output, Pipe2.Input, Pipe3.Input.
-- We could close Pipe1.Output, Pipe2.Input, Pipe3.Input
Dup2 (Pipe1.Input, GNAT.OS_Lib.Standin);
Dup2 (Pipe2.Output, GNAT.OS_Lib.Standout);
......
gcc/ada/gnat1drv.adb
......@@ -87,7 +87,7 @@ procedure Gnat1drv is
-- There are various interactions between front end switch settings,
-- including debug switch settings and target dependent parameters.
-- This procedure takes care of properly handling these interactions.
-- We do it after scanning out all the switches, that way we are not
-- We do it after scanning out all the switches, so that we are not
-- depending on the order in which switches appear.
procedure Check_Bad_Body;
......@@ -174,7 +174,7 @@ procedure Gnat1drv is
-- Deal with forcing OpenVMS switches True if debug flag M is set, but
-- record the setting of Targparm.Open_VMS_On_Target in True_VMS_Target
-- before doing this, so we know if we are in real openVMS or not!
-- before doing this, so we know if we are in real OpenVMS or not!
Opt.True_VMS_Target := Targparm.OpenVMS_On_Target;
......
gcc/ada/output.ads
......@@ -91,7 +91,7 @@ package Output is
-- beginning of the line, wrapping around if it gets too long.
procedure Outdent;
-- Decreases the current indentation level.
-- Decreases the current indentation level
procedure Write_Char (C : Character);
-- Write one character to the standard output file. If the character is LF,
......
gcc/ada/prj-attr.ads
......@@ -6,7 +6,7 @@
-- --
-- S p e c --
-- --
-- Copyright (C) 2001-2008, Free Software Foundation, Inc. --
-- Copyright (C) 2001-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- --
......@@ -183,7 +183,7 @@ package Prj.Attr is
-- Default value of Package_Node_Id objects
Unknown_Package : constant Package_Node_Id;
-- Value of an unknown package that has been found but is unknown.
-- Value of an unknown package that has been found but is unknown
procedure Register_New_Package (Name : String; Id : out Package_Node_Id);
-- Add a new package. Fails if Name (the package name) is empty or is
......
gcc/ada/prj-env.adb
......@@ -384,8 +384,8 @@ package body Prj.Env is
--------------------------------
procedure Create_Config_Pragmas_File
(For_Project : Project_Id;
In_Tree : Project_Tree_Ref)
(For_Project : Project_Id;
In_Tree : Project_Tree_Ref)
is
type Naming_Id is new Nat;
package Naming_Table is new GNAT.Dynamic_Tables
......@@ -436,8 +436,9 @@ package body Prj.Env is
procedure Check (Project : Project_Id; State : in out Integer) is
pragma Unreferenced (State);
Lang : constant Language_Ptr :=
Get_Language_From_Name (Project, "ada");
Get_Language_From_Name (Project, "ada");
Naming : Lang_Naming_Data;
begin
if Current_Verbosity = High then
Write_Str ("Checking project file """);
......@@ -450,6 +451,7 @@ package body Prj.Env is
if Current_Verbosity = High then
Write_Str ("Languages does not contain Ada, nothing to do");
end if;
return;
end if;
......@@ -460,11 +462,11 @@ package body Prj.Env is
Current_Naming := Default_Naming;
while Current_Naming <= Naming_Table.Last (Namings)
and then Namings.Table (Current_Naming).Dot_Replacement =
Naming.Dot_Replacement
Naming.Dot_Replacement
and then Namings.Table (Current_Naming).Casing =
Naming.Casing
Naming.Casing
and then Namings.Table (Current_Naming).Separate_Suffix =
Naming.Separate_Suffix
Naming.Separate_Suffix
loop
Current_Naming := Current_Naming + 1;
end loop;
......@@ -984,7 +986,7 @@ package body Prj.Env is
The_Body_Name : Name_Id;
begin
-- ??? Same block in Project_Od
-- ??? Same block in Project_Of
Canonical_Case_File_Name (Original_Name);
Name_Len := Original_Name'Length;
Name_Buffer (1 .. Name_Len) := Original_Name;
......@@ -994,9 +996,12 @@ package body Prj.Env is
declare
Naming : constant Lang_Naming_Data := Lang.Config.Naming_Data;
Extended_Spec_Name : String :=
Name & Namet.Get_Name_String (Naming.Spec_Suffix);
Name & Namet.Get_Name_String
(Naming.Spec_Suffix);
Extended_Body_Name : String :=
Name & Namet.Get_Name_String (Naming.Body_Suffix);
Name & Namet.Get_Name_String
(Naming.Body_Suffix);
begin
Canonical_Case_File_Name (Extended_Spec_Name);
Name_Len := Extended_Spec_Name'Length;
......@@ -1435,7 +1440,7 @@ package body Prj.Env is
Original_Name : String := Name;
Lang : constant Language_Ptr :=
Get_Language_From_Name (Main_Project, "ada");
Get_Language_From_Name (Main_Project, "ada");
Unit : Unit_Index;
......@@ -1455,9 +1460,12 @@ package body Prj.Env is
declare
Naming : Lang_Naming_Data renames Lang.Config.Naming_Data;
Extended_Spec_Name : String :=
Name & Namet.Get_Name_String (Naming.Spec_Suffix);
Name & Namet.Get_Name_String
(Naming.Spec_Suffix);
Extended_Body_Name : String :=
Name & Namet.Get_Name_String (Naming.Body_Suffix);
Name & Namet.Get_Name_String
(Naming.Body_Suffix);
begin
Canonical_Case_File_Name (Extended_Spec_Name);
Name_Len := Extended_Spec_Name'Length;
......@@ -1469,14 +1477,15 @@ package body Prj.Env is
Name_Buffer (1 .. Name_Len) := Extended_Body_Name;
The_Body_Name := Name_Find;
end;
else
The_Spec_Name := The_Original_Name;
The_Body_Name := The_Original_Name;
end if;
Unit := Units_Htable.Get_First (In_Tree.Units_HT);
while Unit /= null loop
-- Case of a body present
if Unit.File_Names (Impl) /= null then
......
gcc/ada/prj-env.ads
......@@ -62,8 +62,8 @@ package Prj.Env is
-- to the Ada_Only mode.
procedure Create_Config_Pragmas_File
(For_Project : Project_Id;
In_Tree : Project_Tree_Ref);
(For_Project : Project_Id;
In_Tree : Project_Tree_Ref);
-- If there needs to have SFN pragmas, either for non standard naming
-- schemes or for individual units.
......
gcc/ada/s-interr-hwint.adb
......@@ -1078,7 +1078,7 @@ package body System.Interrupts is
POP.Write_Lock (Self_Id);
-- Unassociate the interrupt handler.
-- Unassociate the interrupt handler
Semaphore_ID_Map (Interrupt) := 0;
......
gcc/ada/s-osinte-vms.adb
......@@ -7,7 +7,7 @@
-- B o d y --
-- --
-- Copyright (C) 1991-1994, Florida State University --
-- Copyright (C) 1995-2006, AdaCore --
-- Copyright (C) 1995-2009, AdaCore --
-- --
-- GNARL 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- --
......@@ -32,7 +32,7 @@
-- --
------------------------------------------------------------------------------
-- This is a OpenVMS/Alpha version of this package.
-- This is a OpenVMS/Alpha version of this package
-- This package encapsulates all direct interfaces to OS services
-- that are needed by children of System.
......
gcc/ada/s-secsta.ads
......@@ -83,6 +83,7 @@ package System.Secondary_Stack is
procedure SS_Release (M : Mark_Id);
-- Restore the state of the stack corresponding to the mark M. If an
-- additional chunk have been allocated, it will never be freed during a
-- ??? missing comment here
function SS_Get_Max return Long_Long_Integer;
-- Return maximum used space in storage units for the current secondary
......
gcc/ada/s-stchop-vxworks.adb
......@@ -85,10 +85,12 @@ package body System.Stack_Checking.Operations is
procedure Initialize_Stack_Limit is
begin
-- For the environment task.
-- For the environment task
Set_Stack_Limit_For_Current_Task;
-- Will be called by every created task.
-- Will be called by every created task
Set_Stack_Limit_Hook := Set_Stack_Limit_For_Current_Task'Access;
end Initialize_Stack_Limit;
......@@ -99,10 +101,10 @@ package body System.Stack_Checking.Operations is
procedure Set_Stack_Limit_For_Current_Task is
use Interfaces.C;
-- Import from VxWorks.
function Task_Var_Add (Tid : Interfaces.C.int; Var : Address)
return Interfaces.C.int;
pragma Import (C, Task_Var_Add, "taskVarAdd");
-- Import from VxWorks
type OS_Stack_Info is record
Size : Interfaces.C.int;
......@@ -120,9 +122,11 @@ package body System.Stack_Checking.Operations is
Stack_Info : aliased OS_Stack_Info;
Limit : System.Address;
Limit : System.Address;
begin
-- Get stack bounds from VxWorks.
-- Get stack bounds from VxWorks
Get_Stack_Info (Stack_Info'Access);
if Stack_Grows_Down then
......@@ -131,7 +135,8 @@ package body System.Stack_Checking.Operations is
Limit := Stack_Info.Base + Storage_Offset (Stack_Info.Size);
end if;
-- Note: taskVarAdd implicitly calls taskVarInit if required.
-- Note: taskVarAdd implicitly calls taskVarInit if required
if Task_Var_Add (0, Stack_Limit'Address) = 0 then
Stack_Limit := Limit;
end if;
......
gcc/ada/s-stusta.ads
------------------------------------------------------------------------------
-- --
-- GNAT RUN-TIME LIBRARY (GNARL) COMPONENTS --
-- GNAT RUN-TIME LIBRARY (GNARL) COMPONENTS --
-- --
-- S Y S T E M . S T A C K _ U S A G E . T AS K I N G --
-- S Y S T E M . S T A C K _ U S A G E . T A S K I N G --
-- --
-- S p e c --
-- --
......@@ -60,7 +60,7 @@ package System.Stack_Usage.Tasking is
"__gnat_tasks_stack_usage_report_current_task");
subtype Stack_Usage_Result is System.Stack_Usage.Task_Result;
-- This type is a descriptor for task stack usage result.
-- This type is a descriptor for task stack usage result
type Stack_Usage_Result_Array is
array (Positive range <>) of Stack_Usage_Result;
......
gcc/ada/s-taprop-solaris.adb
......@@ -1136,7 +1136,7 @@ package body System.Task_Primitives.Operations is
-- System.Real_Time.Time_Span in the same way, i.e., as a 64-bit count of
-- nanoseconds.
-- This allows us to always pass the timeout value as a Duration.
-- This allows us to always pass the timeout value as a Duration
-- ???
-- We are taking liberties here with the semantics of the delays. That is,
......
gcc/ada/s-taskin.ads
......@@ -200,7 +200,7 @@ package System.Tasking is
-- completion event/signal to occur.
Activating,
-- Task has been created and is being made Runnable.
-- Task has been created and is being made Runnable
Acceptor_Delay_Sleep
-- Task is waiting on an selective wait statement
......
gcc/ada/s-tpopsp-posix-foreign.adb
......@@ -94,7 +94,7 @@ package body Specific is
begin
Result := pthread_getspecific (ATCB_Key);
-- If the key value is Null, then it is a non-Ada task.
-- If the key value is Null then it is a non-Ada task
if Result /= System.Null_Address then
return To_Task_Id (Result);
......
gcc/ada/s-tpopsp-posix.adb
......@@ -29,7 +29,7 @@
-- --
------------------------------------------------------------------------------
-- This is a POSIX-like version of this package.
-- This is a POSIX-like version of this package
separate (System.Task_Primitives.Operations)
package body Specific is
......
gcc/ada/s-trafor-default.adb
......@@ -6,7 +6,7 @@
-- --
-- B o d y --
-- --
-- Copyright (C) 2001-2009 Free Software Foundation, Inc. --
-- Copyright (C) 2001-2009, Free Software Foundation, Inc. --
-- --
-- GNARL 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- --
......@@ -66,25 +66,25 @@ package body System.Traces.Format is
function Append
(Source : String_Trace;
Annex : String)
return String_Trace
Annex : String) return String_Trace
is
Result : String_Trace := (others => ' ');
Source_Length : Integer := 1;
Annex_Length : Integer := Annex'Length;
Source_Length : Integer;
begin
if Parameters.Runtime_Traces then
-- First we determine the size used, without the spaces at the
-- end, if a String_Trace is present. Look at
-- System.Traces.Tasking for examples.
-- First we determine the size used, without the spaces at the end,
-- if a String_Trace is present. Look at System.Traces.Tasking for
-- examples.
Source_Length := 1;
while Source (Source_Length) /= ASCII.NUL loop
Source_Length := Source_Length + 1;
end loop;
-- Then we fill the string.
-- Then we fill the string
if Source_Length - 1 + Annex_Length <= Max_Size then
Result (1 .. Source_Length - 1) :=
......@@ -97,6 +97,7 @@ package body System.Traces.Format is
Result (Source_Length + Annex_Length + 1 .. Max_Size) :=
(others => ' ');
else
Result (1 .. Source_Length - 1) := Source (1 .. Source_Length - 1);
Result (Source_Length .. Max_Size - 1) :=
......
gcc/ada/scans.ads
......@@ -363,7 +363,7 @@ package Scans is
-- Pointer to first character of current token
Current_Line_Start : Source_Ptr := No_Location; -- init for -gnatVa
-- Pointer to first character of line containing current token.
-- Pointer to first character of line containing current token
Start_Column : Column_Number := No_Column_Number; -- init for -gnatVa
-- Starting column number (zero origin) of the first non-blank character
......@@ -444,6 +444,11 @@ package Scans is
-- Is it really right for this to be a Name rather than a String, what
-- about the case of Wide_Wide_Characters???
Inside_Conditional_Expression : Nat := 0;
-- This is a counter that is set non-zero while scanning out a conditional
-- expression (incremented on entry, decremented on exit). It is used to
-- disconnect format checks that normally apply to keywords THEN, ELSE etc.
--------------------------------------------------------
-- Procedures for Saving and Restoring the Scan State --
--------------------------------------------------------
......
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