+2009-07-22 Robert Dewar <dewar@adacore.com>
+
+ * s-stchop.adb, a-direct.adb, a-ztexio.adb, gnatchop.adb, prj-proc.adb,
+ make.adb, s-regpat.adb, ali-util.adb, a-ngcefu.adb, prep.adb,
+ s-tassta.adb, a-tifiio.adb, a-textio.adb, prj.adb, uintp.adb,
+ s-valrea.adb, a-ngelfu.adb, prepcomp.adb, sinput-l.adb, vms_conv.adb,
+ errout.adb, g-alleve.adb, repinfo.adb, a-wtedit.adb, ali.adb,
+ a-witeio.adb, prj-dect.adb, prj-nmsc.adb, sinput-c.adb, binde.adb,
+ s-regexp.adb, s-imgrea.adb, a-teioed.adb, errutil.adb, prj-util.adb,
+ a-ztedit.adb, gnatls.adb, prj-conf.adb, bcheck.adb, s-scaval.adb,
+ erroutc.adb, osint.adb, a-strfix.adb, s-fileio.adb: Make sure sources
+ obey short-circuit style rule.
+
2009-07-20 Bob Duff <duff@adacore.com>
* sem_ch13.adb (Analyze_Record_Representation_Clause): Use "and then"
then
raise Name_Error with "old file """ & Old_Name & """ does not exist";
- elsif Is_Regular_File (New_Name) or Is_Directory (New_Name) then
+ elsif Is_Regular_File (New_Name) or else Is_Directory (New_Name) then
raise Use_Error with
"new name """ & New_Name
& """ designates a file that already exists";
then
Result := Log_Two + Log (X); -- may have wrong sign
- if (Re (X) < 0.0 and Re (Result) > 0.0)
- or else (Re (X) > 0.0 and Re (Result) < 0.0)
+ if (Re (X) < 0.0 and then Re (Result) > 0.0)
+ or else (Re (X) > 0.0 and then Re (Result) < 0.0)
then
Set_Re (Result, -Re (Result));
end if;
T := Float_Type'Base'Remainder (X, Cycle);
- if T = 0.0 or abs T = 0.5 * Cycle then
+ if T = 0.0 or else abs T = 0.5 * Cycle then
raise Constraint_Error;
elsif abs T < Sqrt_Epsilon then
By : String) return String
is
begin
- if Low > Source'Last + 1 or High < Source'First - 1 then
+ if Low > Source'Last + 1 or else High < Source'First - 1 then
raise Index_Error;
end if;
for J in reverse Attrs.Start_Of_Int .. Attrs.End_Of_Int loop
while Answer (Position) /= '9'
- and Answer (Position) /= Pic.Floater
+ and then
+ Answer (Position) /= Pic.Floater
loop
if Answer (Position) = '_' then
Answer (Position) := Separator_Character;
Last := Pic.Radix_Position + 1;
for J in Last .. Answer'Last loop
- if Answer (J) = '9' or Answer (J) = Pic.Floater then
+ if Answer (J) = '9' or else Answer (J) = Pic.Floater then
Answer (J) := Rounded (Position);
if Rounded (Position) /= '0' then
-- Now get rid of Blank_when_Zero and complete Star fill
- if Zero and Pic.Blank_When_Zero then
+ if Zero and then Pic.Blank_When_Zero then
-- Value is zero, and blank it
return String'(1 .. Last => ' ');
- elsif Zero and Pic.Star_Fill then
+ elsif Zero and then Pic.Star_Fill then
Last := Answer'Last;
if Dollar then
Pic.Picture.Expanded (Index) := 'C';
Skip;
- if Look = 'R' or Look = 'r' then
+ if Look = 'R' or else Look = 'r' then
Pic.Second_Sign := Index;
Pic.Picture.Expanded (Index) := 'R';
Skip;
Pic.Picture.Expanded (Index) := 'D';
Skip;
- if Look = 'B' or Look = 'b' then
+ if Look = 'B' or else Look = 'b' then
Pic.Second_Sign := Index;
Pic.Picture.Expanded (Index) := 'B';
Skip;
-- requested by the user and no '*'.
Pic.Blank_When_Zero :=
- (Computed_BWZ or Pic.Blank_When_Zero) and not Pic.Star_Fill;
+ (Computed_BWZ or else Pic.Blank_When_Zero)
+ and then not Pic.Star_Fill;
-- Star fill if '*' and no '9'
- Pic.Star_Fill := Pic.Star_Fill and Computed_BWZ;
+ Pic.Star_Fill := Pic.Star_Fill and then Computed_BWZ;
if not At_End then
Set_State (Reject);
-- up for such files, so we assume an implicit LM in this case.
loop
- exit when ch = LM or ch = EOF;
+ exit when ch = LM or else ch = EOF;
ch := Getc (File);
end loop;
end if;
Exact : constant Boolean :=
Float'Floor (Num'Small) = Float'Ceiling (Num'Small)
- or Float'Floor (1.0 / Num'Small) = Float'Ceiling (1.0 / Num'Small)
- or Num'Small >= 10.0**Max_Digits;
+ or else Float'Floor (1.0 / Num'Small) =
+ Float'Ceiling (1.0 / Num'Small)
+ or else Num'Small >= 10.0**Max_Digits;
-- True iff a numerator and denominator can be calculated such that
-- their ratio exactly represents the small of Num.
begin
if Last = To'First - 1 then
- if X /= 0 or Pos <= 0 then
+ if X /= 0 or else Pos <= 0 then
-- Before outputting first digit, include leading space,
-- possible minus sign and, if the first digit is fractional,
-- up for such files, so we assume an implicit LM in this case.
loop
- exit when ch = LM or ch = EOF;
+ exit when ch = LM or else ch = EOF;
ch := Getc (File);
end loop;
end if;
for J in reverse Attrs.Start_Of_Int .. Attrs.End_Of_Int loop
while Answer (Position) /= '9'
- and Answer (Position) /= Pic.Floater
+ and then
+ Answer (Position) /= Pic.Floater
loop
if Answer (Position) = '_' then
Answer (Position) := Separator_Character;
for J in Last .. Answer'Last loop
- if Answer (J) = '9' or Answer (J) = Pic.Floater then
+ if Answer (J) = '9' or else Answer (J) = Pic.Floater then
Answer (J) := To_Wide (Rounded (Position));
if Rounded (Position) /= '0' then
-- Now get rid of Blank_when_Zero and complete Star fill
- if Zero and Pic.Blank_When_Zero then
+ if Zero and then Pic.Blank_When_Zero then
-- Value is zero, and blank it
return Wide_String'(1 .. Last => ' ');
- elsif Zero and Pic.Star_Fill then
+ elsif Zero and then Pic.Star_Fill then
Last := Answer'Last;
if Dollar then
Pic.Picture.Expanded (Index) := 'C';
Skip;
- if Look = 'R' or Look = 'r' then
+ if Look = 'R' or else Look = 'r' then
Pic.Second_Sign := Index;
Pic.Picture.Expanded (Index) := 'R';
Skip;
Pic.Picture.Expanded (Index) := 'D';
Skip;
- if Look = 'B' or Look = 'b' then
+ if Look = 'B' or else Look = 'b' then
Pic.Second_Sign := Index;
Pic.Picture.Expanded (Index) := 'B';
Skip;
end case;
-- Blank when zero either if the PIC does not contain a '9' or if
- -- requested by the user and no '*'
+ -- requested by the user and no '*'.
Pic.Blank_When_Zero :=
- (Computed_BWZ or Pic.Blank_When_Zero) and not Pic.Star_Fill;
+ (Computed_BWZ or else Pic.Blank_When_Zero)
+ and then not Pic.Star_Fill;
-- Star fill if '*' and no '9'
- Pic.Star_Fill := Pic.Star_Fill and Computed_BWZ;
+ Pic.Star_Fill := Pic.Star_Fill and then Computed_BWZ;
if not At_End then
Set_State (Reject);
for J in reverse Attrs.Start_Of_Int .. Attrs.End_Of_Int loop
while Answer (Position) /= '9'
- and Answer (Position) /= Pic.Floater
+ and then
+ Answer (Position) /= Pic.Floater
loop
if Answer (Position) = '_' then
Answer (Position) := Separator_Character;
for J in Last .. Answer'Last loop
- if Answer (J) = '9' or Answer (J) = Pic.Floater then
+ if Answer (J) = '9' or else Answer (J) = Pic.Floater then
Answer (J) := To_Wide (Rounded (Position));
if Rounded (Position) /= '0' then
-- Now get rid of Blank_when_Zero and complete Star fill
- if Zero and Pic.Blank_When_Zero then
+ if Zero and then Pic.Blank_When_Zero then
-- Value is zero, and blank it
return Wide_Wide_String'(1 .. Last => ' ');
- elsif Zero and Pic.Star_Fill then
+ elsif Zero and then Pic.Star_Fill then
Last := Answer'Last;
if Dollar then
Pic.Picture.Expanded (Index) := 'C';
Skip;
- if Look = 'R' or Look = 'r' then
+ if Look = 'R' or else Look = 'r' then
Pic.Second_Sign := Index;
Pic.Picture.Expanded (Index) := 'R';
Skip;
Pic.Picture.Expanded (Index) := 'D';
Skip;
- if Look = 'B' or Look = 'b' then
+ if Look = 'B' or else Look = 'b' then
Pic.Second_Sign := Index;
Pic.Picture.Expanded (Index) := 'B';
Skip;
end case;
-- Blank when zero either if the PIC does not contain a '9' or if
- -- requested by the user and no '*'
+ -- requested by the user and no '*'.
Pic.Blank_When_Zero :=
- (Computed_BWZ or Pic.Blank_When_Zero) and not Pic.Star_Fill;
+ (Computed_BWZ or else Pic.Blank_When_Zero)
+ and then not Pic.Star_Fill;
-- Star fill if '*' and no '9'
- Pic.Star_Fill := Pic.Star_Fill and Computed_BWZ;
+ Pic.Star_Fill := Pic.Star_Fill and then Computed_BWZ;
if not At_End then
Set_State (Reject);
-- up for such files, so we assume an implicit LM in this case.
loop
- exit when ch = LM or ch = EOF;
+ exit when ch = LM or else ch = EOF;
ch := Getc (File);
end loop;
end if;
-- --
-- B o d y --
-- --
--- Copyright (C) 1992-2008, Free Software Foundation, Inc. --
+-- Copyright (C) 1992-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- --
then
-- If -dt debug flag set, output time stamp found/expected
- if Source.Table (Src).Source_Found and Debug_Flag_T then
+ if Source.Table (Src).Source_Found and then Debug_Flag_T then
Write_Str ("Source: """);
Get_Name_String (Sdep.Table (D).Sfile);
Write_Str (Name_Buffer (1 .. Name_Len));
loop
Add_Char_To_Name_Buffer (Getc);
- exit when At_End_Of_Field and not Ignore_Spaces;
+ exit when At_End_Of_Field and then not Ignore_Spaces;
if not Ignore_Special then
if Name_Buffer (1) = '"' then
V := V * 10 + (Character'Pos (Getc) - Character'Pos ('0'));
exit when At_End_Of_Field;
- exit when Nextc < '0' or Nextc > '9';
+ exit when Nextc < '0' or else Nextc > '9';
end loop;
return V;
-- --
-- B o d y --
-- --
--- Copyright (C) 1992-2008, Free Software Foundation, Inc. --
+-- Copyright (C) 1992-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- --
-- Case 3. With'ed unit is Preelaborate or Pure
- elsif WU.Preelab or WU.Pure then
+ elsif WU.Preelab or else WU.Pure then
null;
-- Case 4. With'ed unit is internal file
begin
for A2 in A1 + 1 .. ALIs.Last loop
- if ALIs.Table (A2).Locking_Policy /= ' ' and
+ if ALIs.Table (A2).Locking_Policy /= ' '
+ and then
ALIs.Table (A2).Locking_Policy /= Policy
then
Error_Msg_File_1 := ALIs.Table (A1).Sfile;
-- --
-- B o d y --
-- --
--- Copyright (C) 1992-2008, Free Software Foundation, Inc. --
+-- Copyright (C) 1992-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- --
-- Prefer a waiting body to any other case
- if Is_Waiting_Body (U1) and not Is_Waiting_Body (U2) then
+ if Is_Waiting_Body (U1) and then not Is_Waiting_Body (U2) then
if Debug_Flag_B then
Write_Line (" True: u1 is waiting body, u2 is not");
end if;
return True;
- elsif Is_Waiting_Body (U2) and not Is_Waiting_Body (U1) then
+ elsif Is_Waiting_Body (U2) and then not Is_Waiting_Body (U1) then
if Debug_Flag_B then
Write_Line (" False: u2 is waiting body, u1 is not");
end if;
-- Prefer a predefined unit to a non-predefined unit
- elsif UT1.Predefined and not UT2.Predefined then
+ elsif UT1.Predefined and then not UT2.Predefined then
if Debug_Flag_B then
Write_Line (" True: u1 is predefined, u2 is not");
end if;
return True;
- elsif UT2.Predefined and not UT1.Predefined then
+ elsif UT2.Predefined and then not UT1.Predefined then
if Debug_Flag_B then
Write_Line (" False: u2 is predefined, u1 is not");
end if;
-- Prefer an internal unit to a non-internal unit
- elsif UT1.Internal and not UT2.Internal then
+ elsif UT1.Internal and then not UT2.Internal then
if Debug_Flag_B then
Write_Line (" True: u1 is internal, u2 is not");
end if;
return True;
- elsif UT2.Internal and not UT1.Internal then
+ elsif UT2.Internal and then not UT1.Internal then
if Debug_Flag_B then
Write_Line (" False: u2 is internal, u1 is not");
end if;
-- Prefer a body to a spec
- elsif Is_Body_Unit (U1) and not Is_Body_Unit (U2) then
+ elsif Is_Body_Unit (U1) and then not Is_Body_Unit (U2) then
if Debug_Flag_B then
Write_Line (" True: u1 is body, u2 is not");
end if;
return True;
- elsif Is_Body_Unit (U2) and not Is_Body_Unit (U1) then
+ elsif Is_Body_Unit (U2) and then not Is_Body_Unit (U1) then
if Debug_Flag_B then
Write_Line (" False: u2 is body, u1 is not");
end if;
-- Prefer anything else to a waiting body (!)
- elsif Is_Waiting_Body (U1) and not Is_Waiting_Body (U2) then
+ elsif Is_Waiting_Body (U1) and then not Is_Waiting_Body (U2) then
return False;
- elsif Is_Waiting_Body (U2) and not Is_Waiting_Body (U1) then
+ elsif Is_Waiting_Body (U2) and then not Is_Waiting_Body (U1) then
return True;
-- Prefer a spec to a body (!)
- elsif Is_Body_Unit (U1) and not Is_Body_Unit (U2) then
+ elsif Is_Body_Unit (U1) and then not Is_Body_Unit (U2) then
return False;
- elsif Is_Body_Unit (U2) and not Is_Body_Unit (U1) then
+ elsif Is_Body_Unit (U2) and then not Is_Body_Unit (U1) then
return True;
-- If both are waiting bodies, then prefer the one whose spec is
-- Return without doing anything if message is suppressed
if Suppress_Message
- and not All_Errors_Mode
- and not (Msg (Msg'Last) = '!')
- and not Is_Warning_Msg
+ and then not All_Errors_Mode
+ and then not (Msg (Msg'Last) = '!')
+ and then not Is_Warning_Msg
then
if not Continuation then
Last_Killed := True;
-- cascaded parsing errors
if not (Errors.Table (Prev_Msg).Warn
- or
+ or else
Errors.Table (Prev_Msg).Style)
or else
(Errors.Table (Cur_Msg).Warn
- or
+ or else
Errors.Table (Cur_Msg).Style)
then
-- All tests passed, delete the message by simply returning
-- Bump appropriate statistics count
- if Errors.Table (Cur_Msg).Warn or Errors.Table (Cur_Msg).Style then
+ if Errors.Table (Cur_Msg).Warn or else Errors.Table (Cur_Msg).Style then
Warnings_Detected := Warnings_Detected + 1;
else
or else Msg (Msg'Last) = '!'
or else Is_Warning_Msg
or else OK_Node (N)
- or else (Msg (Msg'First) = '\' and not Last_Killed)
+ or else (Msg (Msg'First) = '\' and then not Last_Killed)
then
Debug_Output (N);
Error_Msg_Node_1 := E;
-- Adjust error message count
- if Errors.Table (D).Warn or Errors.Table (D).Style then
+ if Errors.Table (D).Warn or else Errors.Table (D).Style then
Warnings_Detected := Warnings_Detected - 1;
else
and then Errors.Table (E).Sptr > From
and then Errors.Table (E).Sptr < To
then
- if Errors.Table (E).Warn or Errors.Table (E).Style then
+ if Errors.Table (E).Warn or else Errors.Table (E).Style then
Warnings_Detected := Warnings_Detected - 1;
else
-- avoid junk extra messages from cascaded parsing errors
if not (Errors.Table (Prev_Msg).Warn
- or
+ or else
Errors.Table (Prev_Msg).Style)
or else
(Errors.Table (Cur_Msg).Warn
- or
+ or else
Errors.Table (Cur_Msg).Style)
then
-- All tests passed, delete the message by simply returning
-- Bump appropriate statistics count
- if Errors.Table (Cur_Msg).Warn or Errors.Table (Cur_Msg).Style then
+ if Errors.Table (Cur_Msg).Warn
+ or else
+ Errors.Table (Cur_Msg).Style
+ then
Warnings_Detected := Warnings_Detected + 1;
+
else
Total_Errors_Detected := Total_Errors_Detected + 1;
begin
for J in Varray_Type'Range loop
- All_Element := All_Element and (D (J) = Bool_True);
- Any_Element := Any_Element or (D (J) = Bool_True);
+ All_Element := All_Element and then (D (J) = Bool_True);
+ Any_Element := Any_Element or else (D (J) = Bool_True);
end loop;
if A = CR6_LT then
begin
for J in Varray_Type'Range loop
- All_Element := All_Element and (D (J) = Bool_True);
- Any_Element := Any_Element or (D (J) = Bool_True);
+ All_Element := All_Element and then (D (J) = Bool_True);
+ Any_Element := Any_Element or else (D (J) = Bool_True);
end loop;
if A = CR6_LT then
-- --
-- B o d y --
-- --
--- Copyright (C) 1998-2008, Free Software Foundation, Inc. --
+-- Copyright (C) 1998-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- --
-- Find Start_Of_Prefix
for J in reverse Current_Command'Range loop
- if Current_Command (J) = '/' or
- Current_Command (J) = Directory_Separator or
- Current_Command (J) = ':'
+ if Current_Command (J) = '/' or else
+ Current_Command (J) = Directory_Separator or else
+ Current_Command (J) = ':'
then
Start_Of_Prefix := J + 1;
exit;
-- Skip past CR/LF or LF/CR combination
- if (Source (Ptr) = ASCII.CR or Source (Ptr) = ASCII.LF)
+ if (Source (Ptr) = ASCII.CR or else Source (Ptr) = ASCII.LF)
and then Source (Ptr) /= Source (Ptr - 1)
then
Ptr := Ptr + 1;
begin
-- Skip separators
- while Source (Ptr) = ' ' or Source (Ptr) = ',' loop
+ while Source (Ptr) = ' ' or else Source (Ptr) = ',' loop
Ptr := Ptr + 1;
end loop;
-- Find end-of-token
- while (In_Quotes or else not (Source (Ptr) = ' ' or Source (Ptr) = ','))
+ while (In_Quotes
+ or else not (Source (Ptr) = ' ' or else Source (Ptr) = ','))
and then Source (Ptr) >= ' '
loop
if Source (Ptr) = '"' then
Nam : String_Access;
begin
- if Success and Source_References and not Info.SR_Present then
+ if Success and then Source_References and then not Info.SR_Present then
if FTE.SR_Name /= null then
Nam := FTE.SR_Name;
else
end if;
if Verbose_Mode then
- if U.Preelab or
- U.No_Elab or
- U.Pure or
- U.Dynamic_Elab or
- U.Has_RACW or
- U.Remote_Types or
- U.Shared_Passive or
- U.RCI or
- U.Predefined or
- U.Internal or
- U.Is_Generic or
- U.Init_Scalars or
- U.SAL_Interface or
- U.Body_Needed_For_SAL or
+ if U.Preelab or else
+ U.No_Elab or else
+ U.Pure or else
+ U.Dynamic_Elab or else
+ U.Has_RACW or else
+ U.Remote_Types or else
+ U.Shared_Passive or else
+ U.RCI or else
+ U.Predefined or else
+ U.Internal or else
+ U.Is_Generic or else
+ U.Init_Scalars or else
+ U.SAL_Interface or else
+ U.Body_Needed_For_SAL or else
U.Elaborate_Body
then
Write_Eol;
if U.Predefined then
Write_Str (" Predefined");
end if;
-
end if;
declare
Write_Str (" Restrictions violated =>");
-- For boolean restrictions, just display the name of the
- -- restriction; for valued restrictions, also display the
+ -- restriction. For valued restrictions, also display the
-- restriction value.
for Restriction in All_Restrictions loop
-- Find the end of line
Last := Index;
-
while Last <= Buffer'Last
and then Buffer (Last) /= ASCII.LF
and then Buffer (Last) /= ASCII.CR
Add_File (Buffer (Index .. Last - 1));
end if;
- Index := Last;
-
-- Find the beginning of the next line
+ Index := Last;
while Buffer (Index) = ASCII.CR or else
Buffer (Index) = ASCII.LF
loop
Exit_Program (E_Fatal);
end if;
- -- Add the source and object directories specified on the
- -- command line, if any, to the searched directories.
+ -- Add the source and object directories specified on the command line, if
+ -- any, to the searched directories.
while First_Source_Dir /= null loop
Add_Src_Search_Dir (First_Source_Dir.Value.all);
-- Add binder switches from the project file for the first main
- if Do_Bind_Step and Binder_Package /= No_Package then
+ if Do_Bind_Step and then Binder_Package /= No_Package then
if Verbose_Mode then
Write_Str ("Adding binder switches for """);
Write_Str (Main_Unit_File_Name);
-- Add linker switches from the project file for the first main
- if Do_Link_Step and Linker_Package /= No_Package then
+ if Do_Link_Step and then Linker_Package /= No_Package then
if Verbose_Mode then
Write_Str ("Adding linker switches for""");
Write_Str (Main_Unit_File_Name);
and then (Do_Bind_Step
or Unique_Compile_All_Projects
or not Compile_Only)
- and then (Do_Link_Step or N_File = Osint.Number_Of_Files)
+ and then (Do_Link_Step or else N_File = Osint.Number_Of_Files)
then
Library_Projs.Init;
-- We do that only if Run_Path_Option is True
-- (not disabled by -R switch).
- if Run_Path_Option and Path_Option /= null then
+ if Run_Path_Option and then Path_Option /= null then
declare
Option : String_Access;
Length : Natural := Path_Option'Length;
Successful_Links.Table (Successful_Links.Last) :=
Main_ALI_File;
- elsif Osint.Number_Of_Files = 1 or not Keep_Going then
+ elsif Osint.Number_Of_Files = 1
+ or else not Keep_Going
+ then
Make_Failed ("*** link failed.");
else
-- Add binder switches from the project file for this main,
-- if any.
- if Do_Bind_Step and Binder_Package /= No_Package then
+ if Do_Bind_Step and then Binder_Package /= No_Package then
if Verbose_Mode then
Write_Str ("Adding binder switches for """);
Write_Str (Main_Unit_File_Name);
-- Add linker switches from the project file for this main,
-- if any.
- if Do_Link_Step and Linker_Package /= No_Package then
+ if Do_Link_Step and then Linker_Package /= No_Package then
if Verbose_Mode then
Write_Str ("Adding linker switches for""");
Write_Str (Main_Unit_File_Name);
function Check_Project (P : Project_Id) return Boolean is
begin
- if All_Projects or P = The_Project then
+ if All_Projects or else P = The_Project then
return True;
elsif Extending then
RTS_Src_Path_Name := Src_Path_Name;
RTS_Lib_Path_Name := Lib_Path_Name;
- elsif Src_Path_Name = null
- and Lib_Path_Name = null
+ elsif Src_Path_Name = null
+ and then Lib_Path_Name = null
then
Make_Failed ("RTS path not valid: missing " &
"adainclude and adalib directories");
if Command_Name (Cindex2) in '0' .. '9' then
for J in reverse Cindex1 .. Cindex2 loop
- if Command_Name (J) = '.' or Command_Name (J) = ';' then
+ if Command_Name (J) = '.' or else Command_Name (J) = ';' then
Cindex2 := J - 1;
exit;
end if;
loop
Actual_Len := Read (Lib_FD, Text (Hi)'Address, Len);
Hi := Hi + Text_Ptr (Actual_Len);
- exit when Actual_Len = Len or Actual_Len <= 0;
+ exit when Actual_Len = Len or else Actual_Len <= 0;
end loop;
Text (Hi) := EOF;
loop
Actual_Len := Read (Source_File_FD, Actual_Ptr (Hi)'Address, Len);
Hi := Hi + Source_Ptr (Actual_Len);
- exit when Actual_Len = Len or Actual_Len <= 0;
+ exit when Actual_Len = Len or else Actual_Len <= 0;
end loop;
Actual_Ptr (Hi) := EOF;
-- --
-- B o d y --
-- --
--- Copyright (C) 2002-2008, Free Software Foundation, Inc. --
+-- Copyright (C) 2002-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- --
goto Cleanup;
end if;
- elsif Token = Tok_End_Of_Line or Token = Tok_EOF then
+ elsif Token = Tok_End_Of_Line or else Token = Tok_EOF then
Data := (Symbol => Symbol_Name,
Original => Original_Name,
On_The_Command_Line => False,
<<Cleanup>>
Set_Ignore_Errors (To => True);
- while Token /= Tok_End_Of_Line and Token /= Tok_EOF loop
+ while Token /= Tok_End_Of_Line and then Token /= Tok_EOF loop
Scan.all;
end loop;
procedure Output_Line (From, To : Source_Ptr) is
begin
- if Deleting or Preprocessor_Line then
+ if Deleting or else Preprocessor_Line then
if Blank_Deleted_Lines then
New_EOL.all;
New_State : constant Pp_State :=
(If_Ptr => If_Ptr,
Else_Ptr => 0,
- Deleting => Deleting or (not Cond),
- Match_Seen => Deleting or Cond);
+ Deleting => Deleting
+ or else not Cond,
+ Match_Seen => Deleting or else Cond);
begin
Pp_States.Increment_Last;
end if;
end if;
- pragma Assert (Token = Tok_End_Of_Line or Token = Tok_EOF);
+ pragma Assert (Token = Tok_End_Of_Line or else Token = Tok_EOF);
-- At this point, the token is either end of line or EOF.
-- The line to possibly output stops just before the token.
-- with an underline or a digit.
if Name_Buffer (2) = '_'
- or Name_Buffer (2) in '0' .. '9'
+ or else Name_Buffer (2) in '0' .. '9'
then
Error_Msg ("symbol expected", Token_Ptr + 1);
Skip_To_End_Of_Line;
end if;
if Target = "" then
- OK := not Autoconf_Specified or Tgt_Name = No_Name;
+ OK := not Autoconf_Specified or else Tgt_Name = No_Name;
else
OK := Tgt_Name /= No_Name
and then Target = Get_Name_String (Tgt_Name);
-- gprconfig.
if not Is_Directory (Obj_Dir)
- and then (Setup_Projects or Subdirs /= null)
+ and then (Setup_Projects or else Subdirs /= null)
then
begin
Create_Path (Obj_Dir);
-- auto-conf mode, since the appropriate target was passed to gprconfig.
if not Automatically_Generated
- and not Check_Target
- (Config, Autoconf_Specified, Project_Tree, Target_Name)
+ and then not
+ Check_Target (Config, Autoconf_Specified, Project_Tree, Target_Name)
then
Automatically_Generated := True;
goto Process_Config_File;
Expect (Tok_Colon_Equal, "`:=`");
- OK := OK and (Token = Tok_Colon_Equal);
+ OK := OK and then Token = Tok_Colon_Equal;
if Token = Tok_Colon_Equal then
Scan (In_Tree);
end if;
if Prev_Unit /= No_Unit_Index
- and then (Kind = Impl or Kind = Spec)
+ and then (Kind = Impl or else Kind = Spec)
and then Prev_Unit.File_Names (Kind) /= null
then
-- Suspicious, we need to check later whether this is authorized
-- No Naming package or parsing a configuration file? nothing to do
if Naming_Id /= No_Package
- and Project.Qualifier /= Configuration
+ and then Project.Qualifier /= Configuration
then
Naming := Data.Tree.Packages.Table (Naming_Id);
(With_Clause, From_Project_Node_Tree);
New_Project := No_Project;
- if (Limited_With and No (Proj_Node))
- or (not Limited_With and Present (Proj_Node))
+ if (Limited_With and then No (Proj_Node))
+ or else (not Limited_With and then Present (Proj_Node))
then
Recursive_Process
(In_Tree => In_Tree,
if Builder_Package /= No_Package then
Executable_Suffix_Name := Project.Config.Executable_Suffix;
- if Executable = Nil_Variable_Value and Ada_Main then
+ if Executable = Nil_Variable_Value and then Ada_Main then
Get_Name_String (Main);
-- Try as index the name minus the implementation suffix or minus
Real_Index_1 := Index;
- if not Element.Index_Case_Sensitive or Force_Lower_Case_Index then
+ if not Element.Index_Case_Sensitive or else Force_Lower_Case_Index then
if Index /= All_Other_Names then
Get_Name_String (Index);
To_Lower (Name_Buffer (1 .. Name_Len));
Element := In_Tree.Array_Elements.Table (Current);
Real_Index_2 := Element.Index;
- if not Element.Index_Case_Sensitive or Force_Lower_Case_Index then
+ if not Element.Index_Case_Sensitive
+ or else Force_Lower_Case_Index
+ then
if Element.Index /= All_Other_Names then
Get_Name_String (Element.Index);
To_Lower (Name_Buffer (1 .. Name_Len));
Only_If_Ada : Boolean := False) return Path_Name_Type
is
begin
- if (Project.Library and Including_Libraries)
+ if (Project.Library and then Including_Libraries)
or else
(Project.Object_Directory /= No_Path_Information
and then (not Including_Libraries or else not Project.Library))
return B (T (Node.Op1) or else T (Node.Op2));
when Truth_And_Expr =>
- return B (T (Node.Op1) and T (Node.Op2));
+ return B (T (Node.Op1) and then T (Node.Op2));
when Truth_Or_Expr =>
- return B (T (Node.Op1) or T (Node.Op2));
+ return B (T (Node.Op1) or else T (Node.Op2));
when Truth_Xor_Expr =>
return B (T (Node.Op1) xor T (Node.Op2));
end if;
when Out_File =>
- if Amethod = 'D' and not Creat then
+ if Amethod = 'D' and then not Creat then
Fopstr (1) := 'r';
Fopstr (2) := '+';
Fptr := 3;
loop
XP := X * Powten (Maxpow);
- exit when XP >= Powten (S - 1) or Scale < -Maxscaling;
+ exit when XP >= Powten (S - 1) or else Scale < -Maxscaling;
X := XP;
Scale := Scale - Maxpow;
end loop;
loop
XP := X / Powten (Maxpow);
- exit when XP < Powten (S) or Scale > Maxscaling;
+ exit when XP < Powten (S) or else Scale > Maxscaling;
X := XP;
Scale := Scale + Maxpow;
end loop;
-- --
-- B o d y --
-- --
--- Copyright (C) 1999-2008, AdaCore --
+-- Copyright (C) 1999-2009, AdaCore --
-- --
-- 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- --
J := J + 1;
end if;
- if S (J) = ']' or S (J) = '-' then
+ if S (J) = ']' or else S (J) = '-' then
J := J + 1;
end if;
-- Automatically add the first character
- if S (J) = '-' or S (J) = ']' then
+ if S (J) = '-' or else S (J) = ']' then
Set (Table, Current_State, Map (S (J)),
Value => Next_State);
J := J + 1;
-- Automatically add the first character
- if S (J) = '-' or S (J) = ']' then
+ if S (J) = '-' or else S (J) = ']' then
Set (Table, Current_State, Map (S (J)),
Value => Current_State);
J := J + 1;
Flags.Has_Width := False;
end if;
- Flags.SP_Start := Flags.SP_Start or New_Flags.SP_Start;
+ Flags.SP_Start := Flags.SP_Start or else New_Flags.SP_Start;
while Parse_Pos <= Parse_End
and then (E (Parse_Pos) = '|')
Flags.Has_Width := False;
end if;
- Flags.SP_Start := Flags.SP_Start or New_Flags.SP_Start;
+ Flags.SP_Start := Flags.SP_Start or else New_Flags.SP_Start;
end loop;
-- Make a closing node, and hook it on the end
end if;
Expr_Flags.Has_Width :=
- Expr_Flags.Has_Width or New_Flags.Has_Width;
+ Expr_Flags.Has_Width or else New_Flags.Has_Width;
Expr_Flags.SP_Start :=
- Expr_Flags.SP_Start or New_Flags.SP_Start;
+ Expr_Flags.SP_Start or else New_Flags.SP_Start;
end;
when '|' | ASCII.LF | ')' =>
return;
end if;
- Flags.Has_Width := Flags.Has_Width or New_Flags.Has_Width;
+ Flags.Has_Width := Flags.Has_Width or else New_Flags.Has_Width;
if Chain = 0 then -- First piece
- Flags.SP_Start := Flags.SP_Start or New_Flags.SP_Start;
+ Flags.SP_Start := Flags.SP_Start or else New_Flags.SP_Start;
else
Link_Tail (Chain, Last);
end if;
-- Set True if we are on an x86 with 96-bit floats for extended
AFloat : constant Boolean :=
- Long_Float'Size = 48 and Long_Long_Float'Size = 48;
+ Long_Float'Size = 48 and then Long_Long_Float'Size = 48;
-- Set True if we are on an AAMP with 48-bit extended floating point
type ByteLF is array (0 .. 7 - 2 * Boolean'Pos (AFloat)) of Byte1;
function Set_Stack_Info
(Stack : not null access Stack_Access) return Stack_Access;
- -- The function Set_Stack_Info is the actual function that updates
- -- the cache containing a pointer to the Stack_Info. It may also
- -- be used for detecting asynchronous abort in combination with
- -- Invalidate_Self_Cache.
+ -- The function Set_Stack_Info is the actual function that updates the
+ -- cache containing a pointer to the Stack_Info. It may also be used for
+ -- detecting asynchronous abort in combination with Invalidate_Self_Cache.
-- Set_Stack_Info should do the following things in order:
-- 1) Get the Stack_Access value for the current task
-- 2) Set Stack.all to the value obtained in 1)
-- 3) Optionally Poll to check for asynchronous abort
- -- This order is important because if at any time a write to
- -- the stack cache is pending, that write should be followed
- -- by a Poll to prevent loosing signals.
+ -- This order is important because if at any time a write to the stack
+ -- cache is pending, that write should be followed by a Poll to prevent
+ -- loosing signals.
-- Note: This function must be compiled with Polling turned off
if My_Stack.Base = Null_Address then
- -- First invocation, initialize based on the assumption that
- -- there are Environment_Stack_Size bytes available beyond
- -- the current frame address.
+ -- First invocation, initialize based on the assumption that there
+ -- are Environment_Stack_Size bytes available beyond the current
+ -- frame address.
if My_Stack.Size = 0 then
My_Stack.Size := Storage_Offset (Default_Env_Stack_Size);
- -- When the environment variable GNAT_STACK_LIMIT is set,
- -- set Environment_Stack_Size to that number of kB.
+ -- When the environment variable GNAT_STACK_LIMIT is set, set
+ -- Environment_Stack_Size to that number of kB.
Limit_Chars := System.CRTL.getenv ("GNAT_STACK_LIMIT" & ASCII.NUL);
end if;
end if;
- -- If a stack base address has been registered, honor it.
- -- Fallback to the address of a local object otherwise.
+ -- If a stack base address has been registered, honor it. Fallback to
+ -- the address of a local object otherwise.
if My_Stack.Limit /= System.Null_Address then
My_Stack.Base := My_Stack.Limit;
raise Standard'Abort_Signal;
end if;
- return My_Stack; -- Never trust the cached value, but return local copy!
+ -- Never trust the cached value, but return local copy!
+
+ return My_Stack;
end Set_Stack_Info;
-----------------
raise Storage_Error with "stack overflow detected";
end if;
- -- This function first does a "cheap" check which is correct
- -- if it succeeds. In case of failure, the full check is done.
- -- Ideally the cheap check should be done in an optimized manner,
- -- or be inlined.
+ -- This function first does a "cheap" check which is correct if it
+ -- succeeds. In case of failure, the full check is done. Ideally the
+ -- cheap check should be done in an optimized manner, or be inlined.
if (Stack_Grows_Down and then
(Frame_Address <= Cached_Stack.Base
- and
+ and then
Stack_Address > Cached_Stack.Limit))
or else
(not Stack_Grows_Down and then
(Frame_Address >= Cached_Stack.Base
- and
+ and then
Stack_Address < Cached_Stack.Limit))
then
-- Cached_Stack is valid as it passed the stack check
+
return Cached_Stack;
end if;
(not Stack_Grows_Down and then
(not (Frame_Address >= My_Stack.Base)))
then
- -- The returned Base is lower than the stored one,
- -- so assume that the original one wasn't right and use the
- -- current Frame_Address as new one. This allows initializing
- -- Base with the Frame_Address as approximation.
- -- During initialization the Frame_Address will be close to
- -- the stack base anyway: the difference should be compensated
- -- for in the stack reserve.
+ -- The returned Base is lower than the stored one, so assume that
+ -- the original one wasn't right and use the current Frame_Address
+ -- as new one. This allows Base to be initialized with the
+ -- Frame_Address as approximation. During initialization the
+ -- Frame_Address will be close to the stack base anyway: the
+ -- difference should be compensated for in the stack reserve.
My_Stack.Base := Frame_Address;
end if;
- if (Stack_Grows_Down and then
- Stack_Address < My_Stack.Limit)
+ if (Stack_Grows_Down
+ and then Stack_Address < My_Stack.Limit)
or else
- (not Stack_Grows_Down and then
- Stack_Address > My_Stack.Limit)
+ (not Stack_Grows_Down
+ and then Stack_Address > My_Stack.Limit)
then
raise Storage_Error with "stack overflow detected";
end if;
T := To_Be_Freed;
To_Be_Freed := T.Common.All_Tasks_Link;
- -- ??? On SGI there is currently no Interrupt_Manager, that's
- -- why we need to check if the Interrupt_Manager_ID is null
+ -- ??? On SGI there is currently no Interrupt_Manager, that's why we
+ -- need to check if the Interrupt_Manager_ID is null.
- if T.Interrupt_Entry and Interrupt_Manager_ID /= null then
+ if T.Interrupt_Entry and then Interrupt_Manager_ID /= null then
declare
Detach_Interrupt_Entries_Index : constant Task_Entry_Index := 1;
-- Corresponds to the entry index of System.Interrupts.
-- Save up trailing zeroes after the decimal point
- if Digit = 0 and After_Point = 1 then
+ if Digit = 0 and then After_Point = 1 then
Num_Saved_Zeroes := Num_Saved_Zeroes + 1;
-- Here for a non-zero digit
-- Save up trailing zeroes after the decimal point
- if Digit = 0 and After_Point = 1 then
+ if Digit = 0 and then After_Point = 1 then
Num_Saved_Zeroes := Num_Saved_Zeroes + 1;
-- Here for a non-zero digit
-- --
-- B o d y --
-- --
--- Copyright (C) 1992-2007, Free Software Foundation, Inc. --
+-- Copyright (C) 1992-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- --
loop
Actual_Len := Read (Source_File_FD, Actual_Ptr (Hi)'Address, Len);
Hi := Hi + Source_Ptr (Actual_Len);
- exit when Actual_Len = Len or Actual_Len <= 0;
+ exit when Actual_Len = Len or else Actual_Len <= 0;
end loop;
Actual_Ptr (Hi) := EOF;
procedure Wchar (C : Character);
-- Writes character or ? for control character
+ -----------
+ -- Wchar --
+ -----------
+
procedure Wchar (C : Character) is
begin
- if C < ' ' or C in ASCII.DEL .. Character'Val (16#9F#) then
+ if C < ' '
+ or else C in ASCII.DEL .. Character'Val (16#9F#)
+ then
Write_Char ('?');
else
Write_Char (C);
-- --
-- B o d y --
-- --
--- Copyright (C) 1992-2009 Free Software Foundation, Inc. --
+-- Copyright (C) 1992-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- --
function Sum_Digits (Left : Uint; Sign : Int) return Int is
begin
- pragma Assert (Sign = Int_1 or Sign = Int (-1));
+ pragma Assert (Sign = Int_1 or else Sign = Int (-1));
-- First try simple case;
begin
-- First try simple case;
- pragma Assert (Sign = Int_1 or Sign = Int (-1));
+ pragma Assert (Sign = Int_1 or else Sign = Int (-1));
if Direct (Left) then
return Direct_Val (Left);
-- --
-- B o d y --
-- --
--- Copyright (C) 1996-2008, Free Software Foundation, Inc. --
+-- Copyright (C) 1996-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- --
-- Process switch string, first get name
- while SS (P) /= ' ' and SS (P) /= '=' loop
+ while SS (P) /= ' ' and then SS (P) /= '=' loop
P := P + 1;
end loop;