diff options
| author | charlet <charlet@138bc75d-0d04-0410-961f-82ee72b054a4> | 2007-10-15 13:53:48 +0000 |
|---|---|---|
| committer | charlet <charlet@138bc75d-0d04-0410-961f-82ee72b054a4> | 2007-10-15 13:53:48 +0000 |
| commit | 96da32848363deea28bde71dc3d42c34e7067f7a (patch) | |
| tree | a52f2a80bd9bc0b3d34328c89d877fdc3113b84f /gcc/ada | |
| parent | 0d5864d449195511725a88a264cf43006c3a342e (diff) | |
| download | gcc-96da32848363deea28bde71dc3d42c34e7067f7a.tar.gz | |
2007-10-15 Robert Dewar <dewar@adacore.com>
* s-taprop-solaris.adb, s-taprop-vms.adb, s-taprop-mingw.adb,
s-taprop-vxworks.adb, s-taprop-posix.adb, a-calend-vms.adb,
a-calend.adb, a-nuflra.adb, a-tigeau.adb, a-wtgeau.adb,
checks.adb, bindgen.adb, eval_fat.adb, exp_fixd.adb, fmap.adb,
freeze.adb, g-awk.adb, g-calend.adb, g-diopit.adb, g-expect.adb,
gnatchop.adb, gnatlink.adb, g-spipat.adb, g-thread.adb, make.adb,
mdll.adb, mlib.adb, mlib-prj.adb, osint.adb, par-ch3.adb, prj.adb,
prj-makr.adb, sem_prag.adb, sem_type.adb, s-fatgen.adb, s-fileio.adb,
sinfo.ads, sinput-d.adb, s-taasde.adb, s-tasdeb.ads, s-tasren.adb,
s-tassta.adb, s-tpobop.adb, s-tposen.adb, stylesw.adb, types.ads,
uintp.adb, validsw.adb, makegpr.adb, a-rbtgso.adb, a-crbtgo.adb,
a-coorse.adb, a-convec.adb, a-coinve.adb, a-cohama.adb, a-ciorse.adb,
a-cihama.adb, a-cidlli.adb, a-chtgop.adb, a-cdlili.adb, a-cdlili.adb,
a-coormu.adb, a-ciormu.adb, a-cihase.adb, a-cohase.adb, a-ciorma.adb,
a-coorma.adb, a-ztgeau.adb, symbols-vms.adb, a-crdlli.adb,
a-calari.adb, a-calfor.adb, s-os_lib.adb, s-regpat.adb, a-ngrear.adb:
Minor reformatting.
Add Unreferenced and Warnings (Off) pragmas for cases of
variables modified calls where they are IN OUT or OUT parameters and
the resulting values are not subsequently referenced. In a few cases,
we also remove redundant code found by the new warnings.
* ug_words, vms_data.ads, usage.adb, sem_util.adb, sem_util.ads,
sem_warn.adb, sem_warn.ads, sem_res.adb, sem_ch7.adb, sem_ch8.adb,
sem_ch5.adb, opt.ads, lib-xref.adb, lib-xref.ads, exp_smem.adb,
sem_ch11.adb, exp_ch6.adb, einfo.ads, einfo.adb: implement a new
warning controlled by -gnatw.o that warns on cases of out parameter
values being ignored.
git-svn-id: svn+ssh://gcc.gnu.org/svn/gcc/trunk@129318 138bc75d-0d04-0410-961f-82ee72b054a4
Diffstat (limited to 'gcc/ada')
93 files changed, 1055 insertions, 415 deletions
diff --git a/gcc/ada/a-calari.adb b/gcc/ada/a-calari.adb index bf1e103dedf..198f3d5cd11 100644 --- a/gcc/ada/a-calari.adb +++ b/gcc/ada/a-calari.adb @@ -6,7 +6,7 @@ -- -- -- B o d y -- -- -- --- Copyright (C) 2006, Free Software Foundation, Inc. -- +-- Copyright (C) 2006-2007, 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- -- @@ -70,6 +70,9 @@ package body Ada.Calendar.Arithmetic is Days : Long_Integer; Seconds : Duration; Leap_Seconds : Integer; + pragma Warnings (Off, Seconds); -- temporary ??? + pragma Warnings (Off, Leap_Seconds); -- temporary ??? + pragma Unreferenced (Seconds, Leap_Seconds); begin Arithmetic_Operations.Difference (Left, Right, Days, Seconds, Leap_Seconds); diff --git a/gcc/ada/a-calend-vms.adb b/gcc/ada/a-calend-vms.adb index bcfc3dd49bf..fb5ac13cfe8 100644 --- a/gcc/ada/a-calend-vms.adb +++ b/gcc/ada/a-calend-vms.adb @@ -37,6 +37,8 @@ with System.Aux_DEC; use System.Aux_DEC; with Ada.Unchecked_Conversion; +pragma Warnings (Off); -- temp till we fix out param warnings ??? + package body Ada.Calendar is -------------------------- diff --git a/gcc/ada/a-calend.adb b/gcc/ada/a-calend.adb index eb77eac37b2..dfe97ac277d 100644 --- a/gcc/ada/a-calend.adb +++ b/gcc/ada/a-calend.adb @@ -467,10 +467,11 @@ package body Ada.Calendar is --------- function Day (Date : Time) return Day_Number is + D : Day_Number; Y : Year_Number; M : Month_Number; - D : Day_Number; S : Day_Duration; + pragma Unreferenced (Y, M, S); begin Split (Date, Y, M, D, S); return D; @@ -508,6 +509,7 @@ package body Ada.Calendar is M : Month_Number; D : Day_Number; S : Day_Duration; + pragma Unreferenced (Y, D, S); begin Split (Date, Y, M, D, S); return M; @@ -522,6 +524,7 @@ package body Ada.Calendar is M : Month_Number; D : Day_Number; S : Day_Duration; + pragma Unreferenced (Y, M, D); begin Split (Date, Y, M, D, S); return S; @@ -544,6 +547,8 @@ package body Ada.Calendar is Ss : Duration; Le : Boolean; + pragma Unreferenced (H, M, Se, Ss, Le); + begin -- Even though the input time zone is UTC (0), the flag Is_Ada_05 will -- ensure that Split picks up the local time zone. @@ -631,6 +636,7 @@ package body Ada.Calendar is M : Month_Number; D : Day_Number; S : Day_Duration; + pragma Unreferenced (M, D, S); begin Split (Date, Y, M, D, S); return Y; @@ -822,6 +828,8 @@ package body Ada.Calendar is Su : Duration; Le : Boolean; + pragma Unreferenced (Ds, H, Mi, Se, Su, Le); + Day_Count : Long_Integer; Res_Dur : Time_Dur; Res_N : Time_Rep; diff --git a/gcc/ada/a-calfor.adb b/gcc/ada/a-calfor.adb index d16f18730ba..9804e220828 100644 --- a/gcc/ada/a-calfor.adb +++ b/gcc/ada/a-calfor.adb @@ -34,6 +34,8 @@ with Ada.Calendar; use Ada.Calendar; with Ada.Calendar.Time_Zones; use Ada.Calendar.Time_Zones; +pragma Warnings (Off); -- temp till we fix out param warnings ??? + package body Ada.Calendar.Formatting is -------------------------- @@ -93,6 +95,8 @@ package body Ada.Calendar.Formatting is Ss : Second_Duration; Le : Boolean; + pragma Unreferenced (Y, Mo, H, Mi); + begin Split (Date, Y, Mo, D, H, Mi, Se, Ss, Le, Time_Zone); return D; @@ -124,6 +128,8 @@ package body Ada.Calendar.Formatting is Ss : Second_Duration; Le : Boolean; + pragma Unreferenced (Y, Mo, D, Mi); + begin Split (Date, Y, Mo, D, H, Mi, Se, Ss, Le, Time_Zone); return H; @@ -345,6 +351,9 @@ package body Ada.Calendar.Formatting is Se : Second_Number; Ss : Second_Duration; Le : Boolean; + + pragma Unreferenced (Y, Mo, D, H); + begin Split (Date, Y, Mo, D, H, Mi, Se, Ss, Le, Time_Zone); return Mi; @@ -366,6 +375,9 @@ package body Ada.Calendar.Formatting is Se : Second_Number; Ss : Second_Duration; Le : Boolean; + + pragma Unreferenced (Y, D, H, Mi); + begin Split (Date, Y, Mo, D, H, Mi, Se, Ss, Le, Time_Zone); return Mo; @@ -384,6 +396,9 @@ package body Ada.Calendar.Formatting is Se : Second_Number; Ss : Second_Duration; Le : Boolean; + + pragma Unreferenced (Y, Mo, D, H, Mi); + begin Split (Date, Y, Mo, D, H, Mi, Se, Ss, Le); return Se; @@ -413,7 +428,7 @@ package body Ada.Calendar.Formatting is return Day_Duration (Hour * 3_600) + Day_Duration (Minute * 60) + Day_Duration (Second) + - Sub_Second; + Sub_Second; end Seconds_Of; ----------- @@ -613,6 +628,9 @@ package body Ada.Calendar.Formatting is Se : Second_Number; Ss : Second_Duration; Le : Boolean; + + pragma Unreferenced (Y, Mo, D, H, Mi); + begin Split (Date, Y, Mo, D, H, Mi, Se, Ss, Le); return Ss; @@ -923,6 +941,8 @@ package body Ada.Calendar.Formatting is Ss : Second_Duration; Le : Boolean; + pragma Unreferenced (Mo, D, H, Mi); + begin Split (Date, Y, Mo, D, H, Mi, Se, Ss, Le, Time_Zone); return Y; diff --git a/gcc/ada/a-cdlili.adb b/gcc/ada/a-cdlili.adb index 611bfb09b5d..68222ce2d49 100644 --- a/gcc/ada/a-cdlili.adb +++ b/gcc/ada/a-cdlili.adb @@ -6,7 +6,7 @@ -- -- -- B o d y -- -- -- --- Copyright (C) 2004-2006, Free Software Foundation, Inc. -- +-- Copyright (C) 2004-2007, 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- -- @@ -175,7 +175,9 @@ package body Ada.Containers.Doubly_Linked_Lists is Container.Last := null; Container.Length := 0; + pragma Warnings (Off); Free (X); + pragma Warnings (On); end Clear; -------------- @@ -491,6 +493,7 @@ package body Ada.Containers.Doubly_Linked_Lists is if RI.Node.Element < LI.Node.Element then declare RJ : Cursor := RI; + pragma Warnings (Off, RJ); begin RI.Node := RI.Node.Next; Splice (Target, LI, Source, RJ); @@ -664,6 +667,7 @@ package body Ada.Containers.Doubly_Linked_Lists is Count : Count_Type := 1) is Position : Cursor; + pragma Unreferenced (Position); begin Insert (Container, Before, New_Item, Position, Count); end Insert; diff --git a/gcc/ada/a-chtgop.adb b/gcc/ada/a-chtgop.adb index 94a646e3250..dd97c2ebb05 100644 --- a/gcc/ada/a-chtgop.adb +++ b/gcc/ada/a-chtgop.adb @@ -583,6 +583,7 @@ package body Ada.Containers.Hash_Tables.Generic_Operations is declare X : Buckets_Access := HT.Buckets; + pragma Warnings (Off, X); begin HT.Buckets := New_Buckets (Length => NN); Free_Buckets (X); @@ -628,6 +629,7 @@ package body Ada.Containers.Hash_Tables.Generic_Operations is Rehash : declare Dst_Buckets : Buckets_Access := New_Buckets (Length => NN); Src_Buckets : Buckets_Access := HT.Buckets; + pragma Warnings (Off, Src_Buckets); L : Count_Type renames HT.Length; LL : constant Count_Type := L; diff --git a/gcc/ada/a-cidlli.adb b/gcc/ada/a-cidlli.adb index cf9cdcfc39d..4bd0db77b03 100644 --- a/gcc/ada/a-cidlli.adb +++ b/gcc/ada/a-cidlli.adb @@ -7,7 +7,7 @@ -- -- -- B o d y -- -- -- --- Copyright (C) 2004-2006, Free Software Foundation, Inc. -- +-- Copyright (C) 2004-2007, 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- -- @@ -162,6 +162,7 @@ package body Ada.Containers.Indefinite_Doubly_Linked_Lists is procedure Clear (Container : in out List) is X : Node_Access; + pragma Warnings (Off, X); begin if Container.Length = 0 then @@ -539,6 +540,7 @@ package body Ada.Containers.Indefinite_Doubly_Linked_Lists is if RI.Node.Element.all < LI.Node.Element.all then declare RJ : Cursor := RI; + pragma Warnings (Off, RJ); begin RI.Node := RI.Node.Next; Splice (Target, LI, Source, RJ); @@ -735,6 +737,7 @@ package body Ada.Containers.Indefinite_Doubly_Linked_Lists is Count : Count_Type := 1) is Position : Cursor; + pragma Unreferenced (Position); begin Insert (Container, Before, New_Item, Position, Count); end Insert; diff --git a/gcc/ada/a-cihama.adb b/gcc/ada/a-cihama.adb index 2a3e1b58c1d..45dfe984d51 100644 --- a/gcc/ada/a-cihama.adb +++ b/gcc/ada/a-cihama.adb @@ -568,6 +568,8 @@ package body Ada.Containers.Indefinite_Hashed_Maps is New_Item : Element_Type) is Position : Cursor; + pragma Unreferenced (Position); + Inserted : Boolean; begin @@ -965,9 +967,13 @@ package body Ada.Containers.Indefinite_Hashed_Maps is declare K : Key_Type renames Position.Node.Key.all; + E : Element_Type renames Position.Node.Element.all; + pragma Unreferenced (E); + begin Process (K, E); + exception when others => L := L - 1; diff --git a/gcc/ada/a-cihase.adb b/gcc/ada/a-cihase.adb index 8de25a84efc..235f6e36806 100644 --- a/gcc/ada/a-cihase.adb +++ b/gcc/ada/a-cihase.adb @@ -703,6 +703,8 @@ package body Ada.Containers.Indefinite_Hashed_Sets is New_Item : Element_Type) is Position : Cursor; + pragma Unreferenced (Position); + Inserted : Boolean; begin @@ -1138,6 +1140,7 @@ package body Ada.Containers.Indefinite_Hashed_Sets is Element_Keys.Find (Container.HT, New_Item); X : Element_Access; + pragma Warnings (Off, X); begin if Node = null then @@ -1471,9 +1474,11 @@ package body Ada.Containers.Indefinite_Hashed_Sets is ------------ function To_Set (New_Item : Element_Type) return Set is - HT : Hash_Table_Type; + HT : Hash_Table_Type; + Node : Node_Access; Inserted : Boolean; + pragma Unreferenced (Node, Inserted); begin Insert (HT, New_Item, Node, Inserted); @@ -1523,6 +1528,7 @@ package body Ada.Containers.Indefinite_Hashed_Sets is Tgt_Node : Node_Access; Success : Boolean; + pragma Unreferenced (Tgt_Node, Success); -- Start of processing for Process diff --git a/gcc/ada/a-ciorma.adb b/gcc/ada/a-ciorma.adb index 794fc44771b..4372ad404f0 100644 --- a/gcc/ada/a-ciorma.adb +++ b/gcc/ada/a-ciorma.adb @@ -7,7 +7,7 @@ -- -- -- B o d y -- -- -- --- Copyright (C) 2004-2006, Free Software Foundation, Inc. -- +-- Copyright (C) 2004-2007, 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- -- @@ -707,8 +707,9 @@ package body Ada.Containers.Indefinite_Ordered_Maps is Key : Key_Type; New_Item : Element_Type) is - Position : Cursor; + pragma Unreferenced (Position); + Inserted : Boolean; begin @@ -1301,10 +1302,13 @@ package body Ada.Containers.Indefinite_Ordered_Maps is declare K : Key_Type renames Position.Node.Key.all; + E : Element_Type renames Position.Node.Element.all; + pragma Unreferenced (E); begin Process (K, E); + exception when others => L := L - 1; diff --git a/gcc/ada/a-ciormu.adb b/gcc/ada/a-ciormu.adb index f097fdc833b..93e1c841efa 100644 --- a/gcc/ada/a-ciormu.adb +++ b/gcc/ada/a-ciormu.adb @@ -7,7 +7,7 @@ -- -- -- B o d y -- -- -- --- Copyright (C) 2004-2006, Free Software Foundation, Inc. -- +-- Copyright (C) 2004-2007, 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- -- @@ -1052,6 +1052,7 @@ package body Ada.Containers.Indefinite_Ordered_Multisets is procedure Insert (Container : in out Set; New_Item : Element_Type) is Position : Cursor; + pragma Unreferenced (Position); begin Insert (Container, New_Item, Position); end Insert; @@ -1794,9 +1795,9 @@ package body Ada.Containers.Indefinite_Ordered_Multisets is ------------ function To_Set (New_Item : Element_Type) return Set is - Tree : Tree_Type; - Node : Node_Access; - + Tree : Tree_Type; + Node : Node_Access; + pragma Unreferenced (Node); begin Insert_Sans_Hint (Tree, New_Item, Node); return Set'(Controlled with Tree); diff --git a/gcc/ada/a-ciorse.adb b/gcc/ada/a-ciorse.adb index 51a882a93ab..e12abaca00b 100644 --- a/gcc/ada/a-ciorse.adb +++ b/gcc/ada/a-ciorse.adb @@ -7,7 +7,7 @@ -- -- -- B o d y -- -- -- --- Copyright (C) 2004-2006, Free Software Foundation, Inc. -- +-- Copyright (C) 2004-2007, 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- -- @@ -964,7 +964,10 @@ package body Ada.Containers.Indefinite_Ordered_Sets is procedure Insert (Container : in out Set; New_Item : Element_Type) is Position : Cursor; + pragma Unreferenced (Position); + Inserted : Boolean; + begin Insert (Container, New_Item, Position, Inserted); @@ -1032,7 +1035,8 @@ package body Ada.Containers.Indefinite_Ordered_Sets is Src_Node : Node_Access; Dst_Node : out Node_Access) is - Success : Boolean; + Success : Boolean; + pragma Unreferenced (Success); function New_Node return Node_Access; @@ -1434,6 +1438,7 @@ package body Ada.Containers.Indefinite_Ordered_Sets is Element_Keys.Find (Container.Tree, New_Item); X : Element_Access; + pragma Warnings (Off, X); begin if Node = null then @@ -1687,9 +1692,11 @@ package body Ada.Containers.Indefinite_Ordered_Sets is ------------ function To_Set (New_Item : Element_Type) return Set is - Tree : Tree_Type; + Tree : Tree_Type; + Node : Node_Access; Inserted : Boolean; + pragma Unreferenced (Node, Inserted); begin Insert_Sans_Hint (Tree, New_Item, Node, Inserted); diff --git a/gcc/ada/a-cohama.adb b/gcc/ada/a-cohama.adb index d4b8cff88f3..d8f7ff95d77 100644 --- a/gcc/ada/a-cohama.adb +++ b/gcc/ada/a-cohama.adb @@ -520,6 +520,8 @@ package body Ada.Containers.Hashed_Maps is New_Item : Element_Type) is Position : Cursor; + pragma Unreferenced (Position); + Inserted : Boolean; begin @@ -850,6 +852,7 @@ package body Ada.Containers.Hashed_Maps is declare K : Key_Type renames Position.Node.Key; E : Element_Type renames Position.Node.Element; + pragma Unreferenced (E); begin Process (K, E); exception diff --git a/gcc/ada/a-cohase.adb b/gcc/ada/a-cohase.adb index e0db89d5b0c..a3de9502734 100644 --- a/gcc/ada/a-cohase.adb +++ b/gcc/ada/a-cohase.adb @@ -645,6 +645,8 @@ package body Ada.Containers.Hashed_Sets is New_Item : Element_Type) is Position : Cursor; + pragma Unreferenced (Position); + Inserted : Boolean; begin @@ -1329,9 +1331,11 @@ package body Ada.Containers.Hashed_Sets is ------------ function To_Set (New_Item : Element_Type) return Set is - HT : Hash_Table_Type; + HT : Hash_Table_Type; + Node : Node_Access; Inserted : Boolean; + pragma Unreferenced (Node, Inserted); begin Insert (HT, New_Item, Node, Inserted); @@ -1375,6 +1379,7 @@ package body Ada.Containers.Hashed_Sets is Tgt_Node : Node_Access; Success : Boolean; + pragma Unreferenced (Tgt_Node, Success); -- Start of processing for Process diff --git a/gcc/ada/a-coinve.adb b/gcc/ada/a-coinve.adb index 8233a4e9b90..c97f4eb2406 100644 --- a/gcc/ada/a-coinve.adb +++ b/gcc/ada/a-coinve.adb @@ -620,6 +620,8 @@ package body Ada.Containers.Indefinite_Vectors is Position : in out Cursor; Count : Count_Type := 1) is + pragma Warnings (Off, Position); + begin if Position.Container = null then raise Constraint_Error with "Position cursor has no element"; diff --git a/gcc/ada/a-convec.adb b/gcc/ada/a-convec.adb index 64c2a16aa6e..5cbfa0915af 100644 --- a/gcc/ada/a-convec.adb +++ b/gcc/ada/a-convec.adb @@ -425,6 +425,8 @@ package body Ada.Containers.Vectors is Position : in out Cursor; Count : Count_Type := 1) is + pragma Warnings (Off, Position); + begin if Position.Container = null then raise Constraint_Error with "Position cursor has no element"; diff --git a/gcc/ada/a-coorma.adb b/gcc/ada/a-coorma.adb index f6823d4f7b2..01074d58512 100644 --- a/gcc/ada/a-coorma.adb +++ b/gcc/ada/a-coorma.adb @@ -6,7 +6,7 @@ -- -- -- B o d y -- -- -- --- Copyright (C) 2004-2006, Free Software Foundation, Inc. -- +-- Copyright (C) 2004-2007, 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- -- @@ -595,6 +595,8 @@ package body Ada.Containers.Ordered_Maps is New_Item : Element_Type) is Position : Cursor; + pragma Unreferenced (Position); + Inserted : Boolean; begin @@ -1181,10 +1183,13 @@ package body Ada.Containers.Ordered_Maps is declare K : Key_Type renames Position.Node.Key; + E : Element_Type renames Position.Node.Element; + pragma Unreferenced (E); begin Process (K, E); + exception when others => L := L - 1; diff --git a/gcc/ada/a-coormu.adb b/gcc/ada/a-coormu.adb index 8000c991110..07f42a35261 100644 --- a/gcc/ada/a-coormu.adb +++ b/gcc/ada/a-coormu.adb @@ -6,7 +6,7 @@ -- -- -- B o d y -- -- -- --- Copyright (C) 2004-2006, Free Software Foundation, Inc. -- +-- Copyright (C) 2004-2007, 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- -- @@ -983,6 +983,7 @@ package body Ada.Containers.Ordered_Multisets is procedure Insert (Container : in out Set; New_Item : Element_Type) is Position : Cursor; + pragma Unreferenced (Position); begin Insert (Container, New_Item, Position); end Insert; @@ -1700,9 +1701,9 @@ package body Ada.Containers.Ordered_Multisets is ------------ function To_Set (New_Item : Element_Type) return Set is - Tree : Tree_Type; - Node : Node_Access; - + Tree : Tree_Type; + Node : Node_Access; + pragma Unreferenced (Node); begin Insert_Sans_Hint (Tree, New_Item, Node); return Set'(Controlled with Tree); diff --git a/gcc/ada/a-coorse.adb b/gcc/ada/a-coorse.adb index 3cd02332c3c..8a75ee485ae 100644 --- a/gcc/ada/a-coorse.adb +++ b/gcc/ada/a-coorse.adb @@ -6,7 +6,7 @@ -- -- -- B o d y -- -- -- --- Copyright (C) 2004-2006, Free Software Foundation, Inc. -- +-- Copyright (C) 2004-2007, 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- -- @@ -891,6 +891,8 @@ package body Ada.Containers.Ordered_Sets is New_Item : Element_Type) is Position : Cursor; + pragma Unreferenced (Position); + Inserted : Boolean; begin @@ -955,6 +957,7 @@ package body Ada.Containers.Ordered_Sets is Dst_Node : out Node_Access) is Success : Boolean; + pragma Unreferenced (Success); function New_Node return Node_Access; pragma Inline (New_Node); @@ -1591,7 +1594,7 @@ package body Ada.Containers.Ordered_Sets is Tree : Tree_Type; Node : Node_Access; Inserted : Boolean; - + pragma Unreferenced (Node, Inserted); begin Insert_Sans_Hint (Tree, New_Item, Node, Inserted); return Set'(Controlled with Tree); diff --git a/gcc/ada/a-crbtgo.adb b/gcc/ada/a-crbtgo.adb index 4afce91a4f3..83c980dc182 100644 --- a/gcc/ada/a-crbtgo.adb +++ b/gcc/ada/a-crbtgo.adb @@ -7,7 +7,7 @@ -- -- -- B o d y -- -- -- --- Copyright (C) 2004-2006, Free Software Foundation, Inc. -- +-- Copyright (C) 2004-2007, 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- -- @@ -598,6 +598,7 @@ package body Ada.Containers.Red_Black_Trees.Generic_Operations is procedure Generic_Delete_Tree (X : in out Node_Access) is Y : Node_Access; + pragma Warnings (Off, Y); begin while X /= null loop Y := Right (X); diff --git a/gcc/ada/a-crdlli.adb b/gcc/ada/a-crdlli.adb index 1e998007bb7..b5b22bdf82d 100644 --- a/gcc/ada/a-crdlli.adb +++ b/gcc/ada/a-crdlli.adb @@ -7,7 +7,7 @@ -- -- -- B o d y -- -- -- --- Copyright (C) 2004-2006, Free Software Foundation, Inc. -- +-- Copyright (C) 2004-2007, 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- -- @@ -664,7 +664,7 @@ package body Ada.Containers.Restricted_Doubly_Linked_Lists is Count : Count_Type := 1) is Position : Cursor; - + pragma Unreferenced (Position); begin Insert (Container, Before, New_Item, Position, Count); end Insert; @@ -1300,7 +1300,9 @@ package body Ada.Containers.Restricted_Doubly_Linked_Lists is declare I_Next : constant Cursor := Next (I); + J_Copy : Cursor := J; + pragma Warnings (Off, J_Copy); begin if I_Next = J then @@ -1309,7 +1311,9 @@ package body Ada.Containers.Restricted_Doubly_Linked_Lists is else declare J_Next : constant Cursor := Next (J); + I_Copy : Cursor := I; + pragma Warnings (Off, I_Copy); begin if J_Next = I then diff --git a/gcc/ada/a-ngrear.adb b/gcc/ada/a-ngrear.adb index 2ff5d01c0aa..098d5a9a2c5 100644 --- a/gcc/ada/a-ngrear.adb +++ b/gcc/ada/a-ngrear.adb @@ -6,7 +6,7 @@ -- -- -- B o d y -- -- -- --- Copyright (C) 2006, Free Software Foundation, Inc. -- +-- Copyright (C) 2006-2007, 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- -- @@ -455,11 +455,13 @@ package body Ada.Numerics.Generic_Real_Arrays is Vectors : out Real_Matrix) is N : constant Natural := Length (A); - E : Real_Vector (1 .. N); Tau : Real_Vector (1 .. N); L_Work : Real_Vector (1 .. 1); Info : aliased Integer; + E : Real_Vector (1 .. N); + pragma Warnings (Off, E); + begin if Values'Length /= N then raise Constraint_Error with "wrong length for output vector"; @@ -491,7 +493,9 @@ package body Ada.Numerics.Generic_Real_Arrays is Info => Info'Access); declare - Work : Real_Vector (1 .. Integer'Max (Integer (L_Work (1)), 2 * N)); + Work : Real_Vector (1 .. Integer'Max (Integer (L_Work (1)), 2 * N)); + pragma Warnings (Off, Work); + Comp_Z : aliased constant Character := 'V'; begin @@ -554,12 +558,16 @@ package body Ada.Numerics.Generic_Real_Arrays is Values : out Real_Vector) is N : constant Natural := Length (A); - B : Real_Matrix (1 .. N, 1 .. N); - E : Real_Vector (1 .. N); - Tau : Real_Vector (1 .. N); L_Work : Real_Vector (1 .. 1); Info : aliased Integer; + B : Real_Matrix (1 .. N, 1 .. N); + Tau : Real_Vector (1 .. N); + E : Real_Vector (1 .. N); + pragma Warnings (Off, B); + pragma Warnings (Off, Tau); + pragma Warnings (Off, E); + begin if Values'Length /= N then raise Constraint_Error with "wrong length for output vector"; @@ -592,6 +600,7 @@ package body Ada.Numerics.Generic_Real_Arrays is declare Work : Real_Vector (1 .. Integer'Min (Integer (L_Work (1)), 4 * N)); + pragma Warnings (Off, Work); begin -- Reduce matrix to tridiagonal form @@ -677,6 +686,8 @@ package body Ada.Numerics.Generic_Real_Arrays is declare Work : Real_Vector (1 .. Integer (L_Work (1))); + pragma Warnings (Off, Work); + begin -- Compute inverse from LU decomposition diff --git a/gcc/ada/a-nuflra.adb b/gcc/ada/a-nuflra.adb index ae23f459381..397398b3e24 100644 --- a/gcc/ada/a-nuflra.adb +++ b/gcc/ada/a-nuflra.adb @@ -6,7 +6,7 @@ -- -- -- B o d y -- -- -- --- Copyright (C) 1992-2006, Free Software Foundation, Inc. -- +-- Copyright (C) 1992-2007, 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- -- @@ -117,7 +117,7 @@ package body Ada.Numerics.Float_Random is function Euclid (P, Q : Int) return Int is X, Y, GCD : Int; - + pragma Unreferenced (Y, GCD); begin Euclid (P, Q, X, Y, GCD); return X; diff --git a/gcc/ada/a-rbtgso.adb b/gcc/ada/a-rbtgso.adb index fc0c706304a..ad4f76f5df6 100644 --- a/gcc/ada/a-rbtgso.adb +++ b/gcc/ada/a-rbtgso.adb @@ -7,7 +7,7 @@ -- -- -- B o d y -- -- -- --- Copyright (C) 2004-2006, Free Software Foundation, Inc. -- +-- Copyright (C) 2004-2007, 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- -- @@ -51,6 +51,7 @@ package body Ada.Containers.Red_Black_Trees.Generic_Set_Operations is pragma Assert (Tree.Lock = 0); Root : Node_Access := Tree.Root; + pragma Warnings (Off, Root); begin Tree.Root := null; @@ -145,6 +146,7 @@ package body Ada.Containers.Red_Black_Trees.Generic_Set_Operations is R_Node : Node_Access := Right.First; Dst_Node : Node_Access; + pragma Warnings (Off, Dst_Node); begin if Left'Address = Right'Address then @@ -268,6 +270,7 @@ package body Ada.Containers.Red_Black_Trees.Generic_Set_Operations is R_Node : Node_Access := Right.First; Dst_Node : Node_Access; + pragma Warnings (Off, Dst_Node); begin if Left'Address = Right'Address then @@ -396,6 +399,7 @@ package body Ada.Containers.Red_Black_Trees.Generic_Set_Operations is Src : Node_Access := Source.First; New_Tgt_Node : Node_Access; + pragma Warnings (Off, New_Tgt_Node); begin if Target.Busy > 0 then @@ -460,6 +464,7 @@ package body Ada.Containers.Red_Black_Trees.Generic_Set_Operations is R_Node : Node_Access := Right.First; Dst_Node : Node_Access; + pragma Warnings (Off, Dst_Node); begin if Left'Address = Right'Address then diff --git a/gcc/ada/a-tigeau.adb b/gcc/ada/a-tigeau.adb index 919d690bc29..1feed2b4377 100644 --- a/gcc/ada/a-tigeau.adb +++ b/gcc/ada/a-tigeau.adb @@ -319,7 +319,7 @@ package body Ada.Text_IO.Generic_Aux is Ptr : in out Integer) is Junk : Boolean; - + pragma Unreferenced (Junk); begin Load_Extended_Digits (File, Buf, Ptr, Junk); end Load_Extended_Digits; diff --git a/gcc/ada/a-wtgeau.adb b/gcc/ada/a-wtgeau.adb index c020589ee8c..57b9cb72d74 100644 --- a/gcc/ada/a-wtgeau.adb +++ b/gcc/ada/a-wtgeau.adb @@ -6,7 +6,7 @@ -- -- -- B o d y -- -- -- --- Copyright (C) 1992-2005, Free Software Foundation, Inc. -- +-- Copyright (C) 1992-2007, 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- -- @@ -345,7 +345,7 @@ package body Ada.Wide_Text_IO.Generic_Aux is Ptr : in out Integer) is Junk : Boolean; - + pragma Unreferenced (Junk); begin Load_Extended_Digits (File, Buf, Ptr, Junk); end Load_Extended_Digits; diff --git a/gcc/ada/a-ztgeau.adb b/gcc/ada/a-ztgeau.adb index 21b9608db80..fcf36331767 100644 --- a/gcc/ada/a-ztgeau.adb +++ b/gcc/ada/a-ztgeau.adb @@ -6,7 +6,7 @@ -- -- -- B o d y -- -- -- --- Copyright (C) 1992-2005, Free Software Foundation, Inc. -- +-- Copyright (C) 1992-2007, 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- -- @@ -345,7 +345,7 @@ package body Ada.Wide_Wide_Text_IO.Generic_Aux is Ptr : in out Integer) is Junk : Boolean; - + pragma Unreferenced (Junk); begin Load_Extended_Digits (File, Buf, Ptr, Junk); end Load_Extended_Digits; diff --git a/gcc/ada/bindgen.adb b/gcc/ada/bindgen.adb index bf15ffb3ca3..ba6a5a3c1ce 100644 --- a/gcc/ada/bindgen.adb +++ b/gcc/ada/bindgen.adb @@ -2400,9 +2400,9 @@ package body Bindgen is ----------------------- procedure Gen_Output_File_C (Filename : String) is - Bfile : Name_Id; - -- Name of generated bind file + pragma Warnings (Off, Bfile); + -- Name of generated bind file (not referenced) begin Create_Binder_Output (Filename, 'c', Bfile); @@ -2421,7 +2421,6 @@ package body Bindgen is if Use_Pragma_Linker_Constructor then WBI ("extern void " & Ada_Init_Name.all & " (void) __attribute__((constructor));"); - else WBI ("extern void " & Ada_Init_Name.all & " (void);"); end if; diff --git a/gcc/ada/checks.adb b/gcc/ada/checks.adb index 33696b0003c..f9f0c1041bf 100644 --- a/gcc/ada/checks.adb +++ b/gcc/ada/checks.adb @@ -1315,7 +1315,10 @@ package body Checks is LOK : Boolean; Rlo : Uint; Rhi : Uint; - ROK : Boolean; + ROK : Boolean; + + pragma Warnings (Off, Lhi); + -- Don't actually use this value begin if Expander_Active @@ -5201,7 +5204,10 @@ package body Checks is Num_Saved_Checks := 0; - for J in 1 .. Saved_Checks_TOS loop + -- Note: the Int'Min here avoids any possibility of J being out of + -- range when called from e.g. Conditional_Statements_Begin. + + for J in 1 .. Int'Min (Saved_Checks_TOS, Saved_Checks_Stack'Last) loop Saved_Checks_Stack (J) := 0; end loop; end Kill_All_Checks; @@ -6658,10 +6664,6 @@ package body Checks is L_Index : Node_Id; R_Index : Node_Id; - L_Low : Node_Id; - L_High : Node_Id; - R_Low : Node_Id; - R_High : Node_Id; begin L_Index := First_Index (T_Typ); @@ -6672,9 +6674,6 @@ package body Checks is or else Nkind (R_Index) = N_Raise_Constraint_Error) then - Get_Index_Bounds (L_Index, L_Low, L_High); - Get_Index_Bounds (R_Index, R_Low, R_High); - -- Deal with compile time length check. Note that we -- skip this in the access case, because the access -- value may be null, so we cannot know statically. @@ -6691,7 +6690,6 @@ package body Checks is Evolve_Or_Else (Cond, Range_Equal_E_Cond (Exptyp, T_Typ, Indx)); - else Evolve_Or_Else (Cond, Range_E_Cond (Exptyp, T_Typ, Indx)); diff --git a/gcc/ada/einfo.adb b/gcc/ada/einfo.adb index 013fab917a9..ffa4ad08794 100644 --- a/gcc/ada/einfo.adb +++ b/gcc/ada/einfo.adb @@ -174,7 +174,6 @@ package body Einfo is -- Directly_Designated_Type Node20 -- Discriminant_Checking_Func Node20 -- Discriminant_Default_Value Node20 - -- Last_Assignment Node20 -- Last_Entity Node20 -- Register_Exception_Call Node20 -- Scalar_Range Node20 @@ -217,7 +216,8 @@ package body Einfo is -- DT_Offset_To_Top_Func Node25 -- Task_Body_Procedure Node25 - -- Dispatch_Table_Wrapper Node16 + -- Dispatch_Table_Wrapper Node26 + -- Last_Assignment Node26 -- Overridden_Operation Node26 -- Package_Instantiation Node26 -- Related_Interface Node26 @@ -554,7 +554,7 @@ package body Einfo is (Ekind (Id) = E_Constant or else Ekind (Id) = E_Variable or else Ekind (Id) = E_Generic_In_Out_Parameter - or else Ekind (Id) in E_In_Parameter .. E_In_Out_Parameter); + or else Is_Formal (Id)); return Node17 (Id); end Actual_Subtype; @@ -2051,8 +2051,8 @@ package body Einfo is function Last_Assignment (Id : E) return N is begin - pragma Assert (Ekind (Id) = E_Variable); - return Node20 (Id); + pragma Assert (Is_Assignable (Id)); + return Node26 (Id); end Last_Assignment; function Last_Entity (Id : E) return E is @@ -2608,6 +2608,11 @@ package body Einfo is return Ekind (Id) in Array_Kind; end Is_Array_Type; + function Is_Assignable (Id : E) return B is + begin + return Ekind (Id) in Assignable_Kind; + end Is_Assignable; + function Is_Class_Wide_Type (Id : E) return B is begin return Ekind (Id) in Class_Wide_Kind; @@ -2855,7 +2860,7 @@ package body Einfo is (Ekind (Id) = E_Constant or else Ekind (Id) = E_Variable or else Ekind (Id) = E_Generic_In_Out_Parameter - or else Ekind (Id) in E_In_Parameter .. E_In_Out_Parameter); + or else Is_Formal (Id)); Set_Node17 (Id, V); end Set_Actual_Subtype; @@ -4378,8 +4383,8 @@ package body Einfo is procedure Set_Last_Assignment (Id : E; V : N) is begin - pragma Assert (Ekind (Id) = E_Variable); - Set_Node20 (Id, V); + pragma Assert (Is_Assignable (Id)); + Set_Node26 (Id, V); end Set_Last_Assignment; procedure Set_Last_Entity (Id : E; V : E) is @@ -5489,11 +5494,29 @@ package body Einfo is -- Normal case, search enclosing scopes + -- Note: the test for Present (S) should not be required, it is a + -- defence against an ill-formed tree. + S := Scope (Id); - while S /= Standard_Standard - and then not Is_Dynamic_Scope (S) loop - S := Scope (S); + -- If we somehow got an empty value for Scope, the tree must be + -- malformed. Rather than blow up we return Standard in this case. + + if No (S) then + return Standard_Standard; + + -- Quit if we get to standard or a dynamic scope + + elsif S = Standard_Standard + or else Is_Dynamic_Scope (S) + then + return S; + + -- Otherwise keep climbing + + else + S := Scope (S); + end if; end loop; return S; @@ -8038,9 +8061,6 @@ package body Einfo is when E_Exception => Write_Str ("Register_Exception_Call"); - when E_Variable => - Write_Str ("Last_Assignment"); - when others => Write_Str ("Field20??"); end case; @@ -8283,6 +8303,11 @@ package body Einfo is E_Record_Type_With_Private => Write_Str ("Dispatch_Table_Wrapper"); + when E_In_Out_Parameter | + E_Out_Parameter | + E_Variable => + Write_Str ("Last_Assignment"); + when others => Write_Str ("Field26??"); end case; diff --git a/gcc/ada/einfo.ads b/gcc/ada/einfo.ads index 0a6b35ab5d5..8e659f12ab3 100644 --- a/gcc/ada/einfo.ads +++ b/gcc/ada/einfo.ads @@ -2711,11 +2711,12 @@ package Einfo is -- initialization, it may or may not be set if the type does have -- preelaborable initialization. --- Last_Assignment (Node20) --- Present in entities for variables. Set for a local variable to point --- to the left side of an assignment statement assigning a value to the --- variable. Cleared if the value of the variable is referenced. Used to --- warn about dubious assignment statements whose value is not used. +-- Last_Assignment (Node26) +-- Present in entities for variables, and OUT or IN OUT formals. Set for +-- a local variable or formal to point to the left side of an assignment +-- statement assigning a value to the variable. Cleared if the value of +-- the entity is referenced. Used to warn about dubious assignment +-- statements whose value is not used. -- Last_Entity (Node20) -- Present in all entities which act as scopes to which a list of @@ -3630,9 +3631,6 @@ package Einfo is -- Objects -- ------------- - E_Variable, - -- Variables created by an object declaration with no constant keyword - E_Component, -- Components of a record declaration, private declarations of -- protected objects. @@ -3647,21 +3645,24 @@ package Einfo is E_Loop_Parameter, -- A loop parameter created by a for loop + E_Variable, + -- Variables created by an object declaration with no constant keyword + ------------------------ -- Parameter Entities -- ------------------------ -- Parameters are also objects - E_In_Parameter, - -- An in parameter of a subprogram or entry - E_Out_Parameter, -- An out parameter of a subprogram or entry E_In_Out_Parameter, -- An in-out parameter of a subprogram or entry + E_In_Parameter, + -- An in parameter of a subprogram or entry + -------------------------------- -- Generic Parameter Entities -- -------------------------------- @@ -4046,6 +4047,11 @@ package Einfo is -- E_String_Subtype E_String_Literal_Subtype; + subtype Assignable_Kind is Entity_Kind range + E_Variable .. + -- E_Out_Parameter + E_In_Out_Parameter; + subtype Class_Wide_Kind is Entity_Kind range E_Class_Wide_Type .. E_Class_Wide_Subtype; @@ -4156,9 +4162,9 @@ package Einfo is E_Floating_Point_Subtype; subtype Formal_Kind is Entity_Kind range - E_In_Parameter .. - -- E_Out_Parameter - E_In_Out_Parameter; + E_Out_Parameter .. + -- E_In_Out_Parameter + E_In_Parameter; subtype Formal_Object_Kind is Entity_Kind range E_Generic_In_Out_Parameter .. @@ -4214,14 +4220,14 @@ package Einfo is E_Floating_Point_Subtype; subtype Object_Kind is Entity_Kind range - E_Variable .. - -- E_Component + E_Component .. -- E_Constant -- E_Discriminant -- E_Loop_Parameter - -- E_In_Parameter + -- E_Variable -- E_Out_Parameter -- E_In_Out_Parameter + -- E_In_Parameter -- E_Generic_In_Out_Parameter E_Generic_In_Parameter; @@ -4902,12 +4908,14 @@ package Einfo is -- Extra_Formal (Node15) -- Unset_Reference (Node16) -- Actual_Subtype (Node17) + -- Renamed_Object (Node18) -- Spec_Entity (Node19) -- Default_Value (Node20) -- Default_Expr_Function (Node21) -- Protected_Formal (Node22) -- Extra_Constrained (Node23) + -- Last_Assignment (Node26) (OUT, IN-OUT only) -- Has_Initial_Value (Flag219) -- Is_Controlling_Formal (Flag97) -- Is_Optional_Parameter (Flag134) @@ -5282,11 +5290,11 @@ package Einfo is -- Actual_Subtype (Node17) -- Renamed_Object (Node18) -- Size_Check_Code (Node19) - -- Last_Assignment (Node20) -- Interface_Name (Node21) -- Shared_Var_Assign_Proc (Node22) -- Extra_Constrained (Node23) -- Debug_Renaming_Link (Node25) + -- Last_Assignment (Node26) -- Has_Alignment_Clause (Flag46) -- Has_Atomic_Components (Flag86) -- Has_Biased_Representation (Flag139) @@ -5901,6 +5909,7 @@ package Einfo is function Is_Access_Type (Id : E) return B; function Is_Access_Protected_Subprogram_Type (Id : E) return B; function Is_Array_Type (Id : E) return B; + function Is_Assignable (Id : E) return B; function Is_Class_Wide_Type (Id : E) return B; function Is_Composite_Type (Id : E) return B; function Is_Concurrent_Body (Id : E) return B; @@ -6846,6 +6855,7 @@ package Einfo is pragma Inline (Is_Access_Protected_Subprogram_Type); pragma Inline (Is_Aliased); pragma Inline (Is_Array_Type); + pragma Inline (Is_Assignable); pragma Inline (Is_Asynchronous); pragma Inline (Is_Atomic); pragma Inline (Is_Bit_Packed_Array); diff --git a/gcc/ada/eval_fat.adb b/gcc/ada/eval_fat.adb index 78f2e4d5436..ab5e49fbf71 100644 --- a/gcc/ada/eval_fat.adb +++ b/gcc/ada/eval_fat.adb @@ -114,6 +114,7 @@ package body Eval_Fat is function Compose (RT : R; Fraction : T; Exponent : UI) return T is Arg_Frac : T; Arg_Exp : UI; + pragma Warnings (Off, Arg_Exp); begin if UR_Is_Zero (Fraction) then return Fraction; @@ -435,6 +436,7 @@ package body Eval_Fat is function Exponent (RT : R; X : T) return UI is X_Frac : UI; X_Exp : UI; + pragma Warnings (Off, X_Frac); begin if UR_Is_Zero (X) then return Uint_0; @@ -470,6 +472,7 @@ package body Eval_Fat is function Fraction (RT : R; X : T) return T is X_Frac : T; X_Exp : UI; + pragma Warnings (Off, X_Exp); begin if UR_Is_Zero (X) then return X; @@ -726,6 +729,8 @@ package body Eval_Fat is K : UI; P_Even : Boolean; + pragma Warnings (Off, Arg_Frac); + begin if UR_Is_Positive (X) then Sign_X := Ureal_1; diff --git a/gcc/ada/exp_ch6.adb b/gcc/ada/exp_ch6.adb index 7296b8ac0f5..451fa0b7d38 100644 --- a/gcc/ada/exp_ch6.adb +++ b/gcc/ada/exp_ch6.adb @@ -2412,8 +2412,30 @@ package body Exp_Ch6 is if Ekind (Formal) /= E_In_Parameter and then Is_Entity_Name (Actual) + and then Present (Entity (Actual)) then - Kill_Current_Values (Entity (Actual)); + declare + Ent : constant Entity_Id := Entity (Actual); + Sav : Node_Id; + + begin + -- For an OUT parameter that is an assignable entity, we do not + -- want to clobber the Last_Assignment field, since if it is + -- set, it was precisely because it is indeed an OUT parameter! + + if Ekind (Formal) = E_Out_Parameter + and then Is_Assignable (Ent) + then + Sav := Last_Assignment (Ent); + Kill_Current_Values (Ent); + Set_Last_Assignment (Ent, Sav); + + -- For all other cases, just kill the current values + + else + Kill_Current_Values (Ent); + end if; + end; end if; -- If the formal is class wide and the actual is an aggregate, force @@ -5685,10 +5707,26 @@ package body Exp_Ch6 is -- ensure the correct replacement of the object declaration by the -- object renaming declaration to avoid homograph conflicts (since -- the object declaration's defining identifier was already entered - -- in current scope). + -- in current scope). The Next_Entity links of the two entities also + -- have to be swapped since the entities are part of the return + -- scope's entity list and the list structure would otherwise be + -- corrupted. + + declare + Renaming_Def_Id : constant Entity_Id := + Defining_Identifier (Object_Decl); + Next_Entity_Temp : constant Entity_Id := + Next_Entity (Renaming_Def_Id); + begin + Set_Chars (Renaming_Def_Id, Chars (Obj_Def_Id)); + + -- Swap next entity links in preparation for exchanging entities - Set_Chars (Defining_Identifier (Object_Decl), Chars (Obj_Def_Id)); - Exchange_Entities (Defining_Identifier (Object_Decl), Obj_Def_Id); + Set_Next_Entity (Renaming_Def_Id, Next_Entity (Obj_Def_Id)); + Set_Next_Entity (Obj_Def_Id, Next_Entity_Temp); + + Exchange_Entities (Renaming_Def_Id, Obj_Def_Id); + end; end if; -- If the object entity has a class-wide Etype, then we need to change diff --git a/gcc/ada/exp_fixd.adb b/gcc/ada/exp_fixd.adb index 21e1eb13ce6..98268d246e9 100644 --- a/gcc/ada/exp_fixd.adb +++ b/gcc/ada/exp_fixd.adb @@ -416,6 +416,8 @@ package body Exp_Fixd is Rnn : Entity_Id; Code : List_Id; + pragma Warnings (Off, Rnn); + begin Build_Double_Divide_Code (N, X, Y, Z, Qnn, Rnn, Code); Insert_Actions (N, Code); @@ -803,6 +805,8 @@ package body Exp_Fixd is Rnn : Entity_Id; Code : List_Id; + pragma Warnings (Off, Rnn); + begin Build_Scaled_Divide_Code (N, X, Y, Z, Qnn, Rnn, Code); Insert_Actions (N, Code); diff --git a/gcc/ada/exp_smem.adb b/gcc/ada/exp_smem.adb index 8330405613c..b34a1ef80dc 100644 --- a/gcc/ada/exp_smem.adb +++ b/gcc/ada/exp_smem.adb @@ -69,7 +69,7 @@ package body Exp_Smem is function Is_Out_Actual (N : Node_Id) return Boolean; -- In a similar manner, this function determines if N appears as an -- OUT or IN OUT parameter to a procedure call. If the result is - -- True, then Insert_Node is set to point to the assignment. + -- True, then Insert_Node is set to point to the call. --------------------- -- Add_Read_Before -- @@ -245,50 +245,18 @@ package body Exp_Smem is ------------------- function Is_Out_Actual (N : Node_Id) return Boolean is - Parnt : constant Node_Id := Parent (N); - Formal : Entity_Id; - Call : Node_Id; - Actual : Node_Id; + Kind : Entity_Kind; + Call : Node_Id; begin - if (Nkind (Parnt) = N_Indexed_Component - or else - Nkind (Parnt) = N_Selected_Component) - and then N = Prefix (Parnt) - then - return Is_Out_Actual (Parnt); - - elsif Nkind (Parnt) = N_Parameter_Association - and then N = Explicit_Actual_Parameter (Parnt) - then - Call := Parent (Parnt); - - elsif Nkind (Parnt) = N_Procedure_Call_Statement then - Call := Parnt; + Find_Actual_Mode (N, Kind, Call); + if Kind = E_Out_Parameter or else Kind = E_In_Out_Parameter then + Insert_Node := Call; + return True; else return False; end if; - - -- Fall here if we are definitely a parameter - - Actual := First_Actual (Call); - Formal := First_Formal (Entity (Name (Call))); - - loop - if Actual = N then - if Ekind (Formal) /= E_In_Parameter then - Insert_Node := Call; - return True; - else - return False; - end if; - - else - Actual := Next_Actual (Actual); - Formal := Next_Formal (Formal); - end if; - end loop; end Is_Out_Actual; --------------------------- diff --git a/gcc/ada/fmap.adb b/gcc/ada/fmap.adb index dc5d10df974..8f286b3b6f7 100644 --- a/gcc/ada/fmap.adb +++ b/gcc/ada/fmap.adb @@ -490,7 +490,7 @@ package body Fmap is if Last_In_Table = 0 then declare Discard : Boolean; - + pragma Warnings (Off, Discard); begin Delete_File (File_Name, Discard); end; diff --git a/gcc/ada/freeze.adb b/gcc/ada/freeze.adb index c55d46892fb..c6ce9dfa451 100644 --- a/gcc/ada/freeze.adb +++ b/gcc/ada/freeze.adb @@ -1449,10 +1449,12 @@ package body Freeze is procedure Freeze_Record_Type (Rec : Entity_Id) is Comp : Entity_Id; IR : Node_Id; - Junk : Boolean; ADC : Node_Id; Prev : Entity_Id; + Junk : Boolean; + pragma Warnings (Off, Junk); + Unplaced_Component : Boolean := False; -- Set True if we find at least one component with no component -- clause (used to warn about useless Pack pragmas). @@ -2899,8 +2901,10 @@ package body Freeze is and then Known_RM_Size (E) then declare + SizC : constant Node_Id := Size_Clause (E); + Discard : Boolean; - SizC : constant Node_Id := Size_Clause (E); + pragma Warnings (Off, Discard); begin -- It is not clear if it is possible to have no size diff --git a/gcc/ada/g-awk.adb b/gcc/ada/g-awk.adb index e530efc1560..60a85b51c5d 100644 --- a/gcc/ada/g-awk.adb +++ b/gcc/ada/g-awk.adb @@ -6,7 +6,7 @@ -- -- -- B o d y -- -- -- --- Copyright (C) 2000-2006 AdaCore -- +-- Copyright (C) 2000-2007, 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- -- @@ -1475,6 +1475,7 @@ package body GNAT.AWK is procedure Split_Line (Session : Session_Type) is Fields : Field_Table.Instance renames Session.Data.Fields; + pragma Unreferenced (Fields); begin Field_Table.Init (Fields); Split.Current_Line (Session.Data.Separators.all, Session); diff --git a/gcc/ada/g-calend.adb b/gcc/ada/g-calend.adb index f34a0d9d7c9..e2edaff657d 100644 --- a/gcc/ada/g-calend.adb +++ b/gcc/ada/g-calend.adb @@ -45,6 +45,7 @@ package body GNAT.Calendar is Month : Month_Number; Day : Day_Number; Day_Secs : Day_Duration; + pragma Unreferenced (Day_Secs); begin Split (Date, Year, Month, Day, Day_Secs); return Julian_Day (Year, Month, Day) - Julian_Day (Year, 1, 1) + 1; @@ -59,6 +60,7 @@ package body GNAT.Calendar is Month : Month_Number; Day : Day_Number; Day_Secs : Day_Duration; + pragma Unreferenced (Day_Secs); begin Split (Date, Year, Month, Day, Day_Secs); return Day_Name'Val ((Julian_Day (Year, Month, Day)) mod 7); @@ -76,6 +78,7 @@ package body GNAT.Calendar is Minute : Minute_Number; Second : Second_Number; Sub_Second : Second_Duration; + pragma Unreferenced (Year, Month, Day, Minute, Second, Sub_Second); begin Split (Date, Year, Month, Day, Hour, Minute, Second, Sub_Second); return Hour; @@ -135,6 +138,7 @@ package body GNAT.Calendar is Minute : Minute_Number; Second : Second_Number; Sub_Second : Second_Duration; + pragma Unreferenced (Year, Month, Day, Hour, Second, Sub_Second); begin Split (Date, Year, Month, Day, Hour, Minute, Second, Sub_Second); return Minute; @@ -152,6 +156,7 @@ package body GNAT.Calendar is Minute : Minute_Number; Second : Second_Number; Sub_Second : Second_Duration; + pragma Unreferenced (Year, Month, Day, Hour, Minute, Sub_Second); begin Split (Date, Year, Month, Day, Hour, Minute, Second, Sub_Second); return Second; @@ -202,6 +207,7 @@ package body GNAT.Calendar is Minute : Minute_Number; Second : Second_Number; Sub_Second : Second_Duration; + pragma Unreferenced (Year, Month, Day, Hour, Minute, Second); begin Split (Date, Year, Month, Day, Hour, Minute, Second, Sub_Second); return Sub_Second; @@ -220,6 +226,7 @@ package body GNAT.Calendar is Second : Second_Number; Sub_Second : Second_Duration := 0.0) return Time is + Day_Secs : constant Day_Duration := Day_Duration (Hour * 3_600) + Day_Duration (Minute * 60) + @@ -297,6 +304,8 @@ package body GNAT.Calendar is Shift : Week_In_Year_Number; Start_Week : Week_In_Year_Number; + pragma Unreferenced (Hour, Minute, Second, Sub_Second); + function Is_Leap (Year : Year_Number) return Boolean; -- Return True if Year denotes a leap year. Leap centential years are -- properly handled. diff --git a/gcc/ada/g-diopit.adb b/gcc/ada/g-diopit.adb index d57ca385832..e88d2ee6c43 100644 --- a/gcc/ada/g-diopit.adb +++ b/gcc/ada/g-diopit.adb @@ -6,7 +6,7 @@ -- -- -- B o d y -- -- -- --- Copyright (C) 2001-2005, AdaCore -- +-- Copyright (C) 2001-2007, 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- -- @@ -78,10 +78,12 @@ package body GNAT.Directory_Operations.Iteration is -------------------- procedure Read_Directory (Directory : Dir_Name_Str) is - Dir : Dir_Type; Buffer : String (1 .. 2_048); Last : Natural; + Dir : Dir_Type; + pragma Warnings (Off, Dir); + begin Open (Dir, Directory); @@ -319,7 +321,10 @@ package body GNAT.Directory_Operations.Iteration is is File_Regexp : constant Regexp.Regexp := Regexp.Compile (File_Pattern, Glob => True); - Dir : Dir_Type; + + Dir : Dir_Type; + pragma Warnings (Off, Dir); + Buffer : String (1 .. 2_048); Last : Natural; diff --git a/gcc/ada/g-expect.adb b/gcc/ada/g-expect.adb index fb9d296e513..237f3f498fb 100644 --- a/gcc/ada/g-expect.adb +++ b/gcc/ada/g-expect.adb @@ -248,6 +248,7 @@ package body GNAT.Expect is procedure Close (Descriptor : in out Process_Descriptor) is Status : Integer; + pragma Unreferenced (Status); begin Close (Descriptor, Status); end Close; @@ -299,7 +300,7 @@ package body GNAT.Expect is Full_Buffer : Boolean := False) is Matched : GNAT.Regpat.Match_Array (0 .. 0); - + pragma Warnings (Off, Matched); begin Expect (Descriptor, Result, Regexp, Matched, Timeout, Full_Buffer); end Expect; @@ -385,7 +386,9 @@ package body GNAT.Expect is Full_Buffer : Boolean := False) is Patterns : Compiled_Regexp_Array (Regexps'Range); - Matched : GNAT.Regpat.Match_Array (0 .. 0); + + Matched : GNAT.Regpat.Match_Array (0 .. 0); + pragma Warnings (Off, Matched); begin for J in Regexps'Range loop @@ -407,7 +410,7 @@ package body GNAT.Expect is Full_Buffer : Boolean := False) is Matched : GNAT.Regpat.Match_Array (0 .. 0); - + pragma Warnings (Off, Matched); begin Expect (Descriptor, Result, Regexps, Matched, Timeout, Full_Buffer); end Expect; @@ -419,7 +422,7 @@ package body GNAT.Expect is Full_Buffer : Boolean := False) is Matched : GNAT.Regpat.Match_Array (0 .. 0); - + pragma Warnings (Off, Matched); begin Expect (Result, Regexps, Matched, Timeout, Full_Buffer); end Expect; @@ -815,6 +818,7 @@ package body GNAT.Expect is declare Result : Expect_Match; + pragma Unreferenced (Result); begin -- This loop runs until the call to Expect raises Process_Died @@ -1117,10 +1121,11 @@ package body GNAT.Expect is Empty_Buffer : Boolean := False) is Line_Feed : aliased constant String := (1 .. 1 => ASCII.LF); - Result : Expect_Match; Descriptors : Array_Of_Pd := (1 => Descriptor'Unrestricted_Access); + Result : Expect_Match; Discard : Natural; + pragma Warnings (Off, Result); pragma Warnings (Off, Discard); begin @@ -1238,6 +1243,7 @@ package body GNAT.Expect is Pipe3 : not null access Pipe_Type) is Status : Boolean; + pragma Unreferenced (Status); begin -- Create the pipes diff --git a/gcc/ada/g-spipat.adb b/gcc/ada/g-spipat.adb index 49d9bf6bac9..09f2efaacf9 100644 --- a/gcc/ada/g-spipat.adb +++ b/gcc/ada/g-spipat.adb @@ -2803,11 +2803,13 @@ package body GNAT.Spitbol.Patterns is (Subject : VString; Pat : Pattern) return Boolean is - Start : Natural; - Stop : Natural; S : String_Access; L : Natural; + Start : Natural; + Stop : Natural; + pragma Unreferenced (Stop); + begin Get_String (Subject, S, L); @@ -2825,6 +2827,8 @@ package body GNAT.Spitbol.Patterns is Pat : Pattern) return Boolean is Start, Stop : Natural; + pragma Unreferenced (Stop); + subtype String1 is String (1 .. Subject'Length); begin @@ -2898,10 +2902,12 @@ package body GNAT.Spitbol.Patterns is (Subject : VString; Pat : Pattern) is + S : String_Access; + L : Natural; + Start : Natural; Stop : Natural; - S : String_Access; - L : Natural; + pragma Unreferenced (Start, Stop); begin Get_String (Subject, S, L); @@ -2918,7 +2924,10 @@ package body GNAT.Spitbol.Patterns is Pat : Pattern) is Start, Stop : Natural; + pragma Unreferenced (Start, Stop); + subtype String1 is String (1 .. Subject'Length); + begin if Debug_Mode then XMatchD (String1 (Subject), Pat.P, Pat.Stk, Start, Stop); @@ -3093,10 +3102,12 @@ package body GNAT.Spitbol.Patterns is (Subject : VString; Pat : PString) is + S : String_Access; + L : Natural; + Start : Natural; Stop : Natural; - S : String_Access; - L : Natural; + pragma Unreferenced (Start, Stop); begin Get_String (Subject, S, L); @@ -3113,6 +3124,8 @@ package body GNAT.Spitbol.Patterns is Pat : PString) is Start, Stop : Natural; + pragma Unreferenced (Start, Stop); + subtype String1 is String (1 .. Subject'Length); begin diff --git a/gcc/ada/g-thread.adb b/gcc/ada/g-thread.adb index 94719ce9bd7..9f584fdc1ce 100644 --- a/gcc/ada/g-thread.adb +++ b/gcc/ada/g-thread.adb @@ -68,6 +68,7 @@ package body GNAT.Threads is Parm : Void_Ptr; Code : Code_Proc) is + pragma Unreferenced (Parm); pragma Priority (Prio); pragma Storage_Size (Stsz); end Thread; diff --git a/gcc/ada/gnatchop.adb b/gcc/ada/gnatchop.adb index 03d797e743f..9957dee094f 100644 --- a/gcc/ada/gnatchop.adb +++ b/gcc/ada/gnatchop.adb @@ -428,9 +428,11 @@ procedure Gnatchop is File.Table (Input).Name.all & ASCII.Nul; Length : File_Offset; Buffer : String_Access; - Success : Boolean; Result : String_Access; + Success : Boolean; + pragma Warnings (Off, Success); + begin FD := Open_Read (Name'Address, Binary); diff --git a/gcc/ada/gnatlink.adb b/gcc/ada/gnatlink.adb index c3cb72677b9..42fcdc94bb9 100644 --- a/gcc/ada/gnatlink.adb +++ b/gcc/ada/gnatlink.adb @@ -692,6 +692,7 @@ procedure Gnatlink is -- Used for various Interfaces.C_Streams calls Closing_Status : Boolean; + pragma Warnings (Off, Closing_Status); -- For call to Close GNAT_Static : Boolean := False; @@ -1589,7 +1590,7 @@ begin -- convenient to eliminate the redundancy by keying the -- compilation mode on a single switch, namely --RTS. - -- Pass -mrtp to the linker if --RTS=rtp was passed. + -- Pass -mrtp to the linker if --RTS=rtp was passed if Linker_Path = Gcc_Path and then Arg'Length > 8 @@ -1599,7 +1600,7 @@ begin Linker_Options.Table (Linker_Options.Last) := new String'("-mrtp"); - -- Pass -fsjlj to the linker if --RTS=sjlj was passed. + -- Pass -fsjlj to the linker if --RTS=sjlj was passed elsif Linker_Path = Gcc_Path and then Arg'Length > 9 diff --git a/gcc/ada/lib-xref.adb b/gcc/ada/lib-xref.adb index c12f7944ad2..b0a96af5c26 100644 --- a/gcc/ada/lib-xref.adb +++ b/gcc/ada/lib-xref.adb @@ -44,7 +44,7 @@ with Stand; use Stand; with Table; use Table; with Widechar; use Widechar; -with GNAT.Heap_Sort_A; +with GNAT.Heap_Sort_G; package body Lib.Xref is @@ -200,11 +200,11 @@ package body Lib.Xref is ------------------------ procedure Generate_Reference - (E : Entity_Id; - N : Node_Id; - Typ : Character := 'r'; - Set_Ref : Boolean := True; - Force : Boolean := False) + (E : Entity_Id; + N : Node_Id; + Typ : Character := 'r'; + Set_Ref : Boolean := True; + Force : Boolean := False) is Indx : Nat; Nod : Node_Id; @@ -212,18 +212,25 @@ package body Lib.Xref is Def : Source_Ptr; Ent : Entity_Id; + Kind : Entity_Kind; + Call : Node_Id; + -- Arguments used in call to Find_Actual_Mode + function Is_On_LHS (Node : Node_Id) return Boolean; -- Used to check if a node is on the left hand side of an assignment. -- The following cases are handled: -- - -- Variable Node is a direct descendant of an assignment statement. + -- Variable Node is a direct descendant of left hand side of an + -- assignment statement. + -- + -- Prefix Of an indexed or selected component that is present in + -- a subtree rooted by an assignment statement. There is + -- no restriction of nesting of components, thus cases + -- such as A.B (C).D are handled properly. However a prefix + -- of a dereference (either implicit or explicit) is never + -- considered as on a LHS. -- - -- Prefix Of an indexed or selected component that is present in a - -- subtree rooted by an assignment statement. There is no - -- restriction of nesting of components, thus cases such as - -- A.B (C).D are handled properly. - -- However a prefix of a dereference (either implicit or - -- explicit) is never considered as on a LHS. + -- Out param Same as above cases, but OUT parameter --------------- -- Is_On_LHS -- @@ -235,28 +242,41 @@ package body Lib.Xref is -- Sem_Util.May_Be_Lvalue -- Sem_Util.Known_To_Be_Assigned -- Exp_Ch2.Expand_Entry_Parameter.In_Assignment_Context + -- Exp_Smem.Is_Out_Actual function Is_On_LHS (Node : Node_Id) return Boolean is - N : Node_Id := Node; + N : Node_Id; + P : Node_Id; + K : Node_Kind; begin -- Only identifiers are considered, is this necessary??? - if Nkind (N) /= N_Identifier then + if Nkind (Node) /= N_Identifier then return False; end if; - -- Reach the assignment statement subtree root. In the case of a - -- variable being a direct descendant of an assignment statement, - -- the loop is skiped. + -- Immediat return if appeared as OUT parameter - while Nkind (Parent (N)) /= N_Assignment_Statement loop + if Kind = E_Out_Parameter then + return True; + end if; - -- Check whether the parent is a component and the current node - -- is its prefix, but return False if the current node has an - -- access type, as in that case the selected or indexed component - -- is an implicit dereference, and the LHS is the designated - -- object, not the access object. + -- Search for assignment statement subtree root + + N := Node; + loop + P := Parent (N); + K := Nkind (P); + + if K = N_Assignment_Statement then + return Name (P) = N; + + -- Check whether the parent is a component and the current node is + -- its prefix, but return False if the current node has an access + -- type, as in that case the selected or indexed component is an + -- implicit dereference, and the LHS is the designated object, not + -- the access object. -- ??? case of a slice assignment? @@ -267,15 +287,16 @@ package body Lib.Xref is -- dereference. If the dereference is on an LHS, this causes a -- false positive. - if (Nkind (Parent (N)) = N_Selected_Component - or else - Nkind (Parent (N)) = N_Indexed_Component) - and then Prefix (Parent (N)) = N + elsif (K = N_Selected_Component or else K = N_Indexed_Component) + and then Prefix (P) = N and then not (Present (Etype (N)) and then Is_Access_Type (Etype (N))) then - N := Parent (N); + N := P; + + -- All other cases, definitely not on left side + else return False; end if; @@ -290,6 +311,7 @@ package body Lib.Xref is begin pragma Assert (Nkind (E) in N_Entity); + Find_Actual_Mode (N, Kind, Call); -- Check for obsolescent reference to package ASCII. GNAT treats this -- element of annex J specially since in practice, programs make a lot @@ -393,7 +415,18 @@ package body Lib.Xref is if (Ekind (E) = E_Variable or else Is_Formal (E)) and then Is_On_LHS (N) then - Set_Referenced_As_LHS (E); + -- If we have the OUT parameter case and the warning mode for + -- OUT parameters is not set, treat this as an ordinary reference + -- since we don't want warnings about it being unset. + + if Kind = E_Out_Parameter and not Warn_On_Out_Parameter_Unread then + Set_Referenced (E); + + -- For other cases, set referenced on LHS + + else + Set_Referenced_As_LHS (E); + end if; -- Check for a reference in a pragma that should not count as a -- making the variable referenced for warning purposes. @@ -433,13 +466,49 @@ package body Lib.Xref is then null; - -- Any other occurrence counts as referencing the entity + -- All other cases else - Set_Referenced (E); + -- Special processing for IN OUT and OUT parameters, where we + -- have an implicit assignment to a simple variable. + + if (Kind = E_Out_Parameter or else Kind = E_In_Out_Parameter) + and then Is_Entity_Name (N) + and then Present (Entity (N)) + and then Is_Assignable (Entity (N)) + then + -- Record implicit assignment unless we have an intrinsic + -- subprogram, which is most likely an instantiation of + -- Unchecked_Deallocation which we do not want to consider + -- as an assignment since it generates false positives. We + -- also exclude the case of an IN OUT parameter to a procedure + -- called Free, since we suspect similar semantics. + + if Is_Entity_Name (Name (Call)) + and then not Is_Intrinsic_Subprogram (Entity (Name (Call))) + and then (Kind /= E_In_Out_Parameter + or else Chars (Name (Call)) /= Name_Free) + then + Set_Referenced_As_LHS (E); + end if; + + -- For IN OUT case, treat as also being normal reference + + if Kind = E_In_Out_Parameter then + Set_Referenced (E); + end if; + + -- Any other occurrence counts as referencing the entity + + else + Set_Referenced (E); + + -- If variable, this is an OK reference after an assignment + -- so we can clear the Last_Assignment indication. - if Ekind (E) = E_Variable then - Set_Last_Assignment (E, Empty); + if Is_Assignable (E) then + Set_Last_Assignment (E, Empty); + end if; end if; end if; @@ -954,11 +1023,14 @@ package body Lib.Xref is Handle_Orphan_Type_References : declare J : Nat; Tref : Entity_Id; - L, R : Character; Indx : Nat; Ent : Entity_Id; Loc : Source_Ptr; + L, R : Character; + pragma Warnings (Off, L); + pragma Warnings (Off, R); + procedure New_Entry (E : Entity_Id); -- Make an additional entry into the Xref table for a type entity -- that is related to the current entity (parent, type ancestor, @@ -1140,6 +1212,8 @@ package body Lib.Xref is procedure Move (From : Natural; To : Natural); -- Move procedure for Sort call + package Sorting is new GNAT.Heap_Sort_G (Move, Lt); + -------- -- Lt -- -------- @@ -1230,10 +1304,7 @@ package body Lib.Xref is -- Sort the references - GNAT.Heap_Sort_A.Sort - (Integer (Nrefs), - Move'Unrestricted_Access, - Lt'Unrestricted_Access); + Sorting.Sort (Integer (Nrefs)); -- Eliminate duplicate entries @@ -1272,9 +1343,12 @@ package body Lib.Xref is for Refno in 1 .. Nrefs loop Output_One_Ref : declare P2 : Source_Ptr; + Ent : Entity_Id; + WC : Char_Code; Err : Boolean; - Ent : Entity_Id; + pragma Warnings (Off, WC); + pragma Warnings (Off, Err); XE : Xref_Entry renames Xrefs.Table (Rnums (Refno)); -- The current entry to be accessed diff --git a/gcc/ada/lib-xref.ads b/gcc/ada/lib-xref.ads index c40f483df05..1a96e81e6a4 100644 --- a/gcc/ada/lib-xref.ads +++ b/gcc/ada/lib-xref.ads @@ -115,11 +115,18 @@ package Lib.Xref is -- For a type that implements multiple interfaces, there is an -- entry of the form LR=<> for each of the interfaces appearing - -- in the type declaration. + -- in the type declaration. In the data structures of ali.ads, + -- the type that the entity extends (or the first interface if + -- there is no such type) is stored in Xref_Entity_Record.Tref*, + -- additional interfaces are stored in the list of references + -- with a special type of Interface_Reference. -- For an array type, there is an entry of the form LR=<> for -- each of the index types appearing in the type declaration. -- The index types follow the entry for the component type. + -- In the data structures of ali.ads, however, the list of index + -- types are output in the list of references with a special + -- Rtype set to Array_Index_Reference. -- In the above list LR shows the brackets used in the output, -- which has one of the two following forms: @@ -561,11 +568,11 @@ package Lib.Xref is -- a renaming of a predefined operator. procedure Generate_Reference - (E : Entity_Id; - N : Node_Id; - Typ : Character := 'r'; - Set_Ref : Boolean := True; - Force : Boolean := False); + (E : Entity_Id; + N : Node_Id; + Typ : Character := 'r'; + Set_Ref : Boolean := True; + Force : Boolean := False); -- This procedure is called to record a reference. N is the location -- of the reference and E is the referenced entity. Typ is one of: -- @@ -605,22 +612,22 @@ package Lib.Xref is -- the node N is not an identifier, defining identifier, or expanded name -- the type is 'p' and the entity is not in the extended main source -- - -- If all these conditions are met, then the Is_Referenced flag of E - -- is set (unless Set_Ref is False) and a cross-reference entry is - -- recorded for later output when Output_References is called. + -- If all these conditions are met, then the Is_Referenced flag of E is set + -- (unless Set_Ref is False) and a cross-reference entry is recorded for + -- later output when Output_References is called. -- -- Note: the dummy space entry is for the convenience of some callers, -- who find it easier to pass a space to suppress the entry than to do -- a specific test. The call has no effect if the type is a space. -- - -- The parameter Set_Ref is normally True, and indicates that in - -- addition to generating a cross-reference, the Referenced flag - -- of the specified entity should be set. If this parameter is - -- False, then setting of the Referenced flag is inhibited. + -- The parameter Set_Ref is normally True, and indicates that in addition + -- to generating a cross-reference, the Referenced flag of the specified + -- entity should be set. If this parameter is False, then setting of the + -- Referenced flag is inhibited. -- - -- The parameter Force is set to True to force a reference to be - -- generated even if Comes_From_Source is false. This is used for - -- certain implicit references, and also for end label references. + -- The parameter Force is set to True to force a reference to be generated + -- even if Comes_From_Source is false. This is used for certain implicit + -- references, and also for end label references. procedure Generate_Reference_To_Formals (E : Entity_Id); -- Add a reference to the definition of each formal on the line for diff --git a/gcc/ada/make.adb b/gcc/ada/make.adb index c2c10ad1958..a5c784d0b3a 100644 --- a/gcc/ada/make.adb +++ b/gcc/ada/make.adb @@ -3947,6 +3947,7 @@ package body Make is procedure Delete_Mapping_Files is Success : Boolean; + pragma Warnings (Off, Success); begin if not Debug.Debug_Flag_N then if The_Mapping_File_Names /= null then @@ -3968,6 +3969,8 @@ package body Make is procedure Delete_Temp_Config_Files is Success : Boolean; + pragma Warnings (Off, Success); + begin if (not Debug.Debug_Flag_N) and Main_Project /= No_Project then for Project in Project_Table.First .. @@ -4203,6 +4206,7 @@ package body Make is -- The path name of the mapping file Discard : Boolean; + pragma Warnings (Off, Discard); procedure Check_Mains; -- Check that the main subprograms do exist and that they all @@ -7077,9 +7081,11 @@ package body Make is Get_Name_String (Source_File); Saved_Verbosity : constant Verbosity := Current_Verbosity; Project : Project_Id := No_Project; - Path_Name : Path_Name_Type := No_Path; Data : Project_Data; + Path_Name : Path_Name_Type := No_Path; + pragma Warnings (Off, Path_Name); + begin -- Call Get_Reference to know the ultimate extending project of -- the source. Call it with verbosity default to avoid verbose diff --git a/gcc/ada/makegpr.adb b/gcc/ada/makegpr.adb index 4548916aee3..3011c420bb8 100644 --- a/gcc/ada/makegpr.adb +++ b/gcc/ada/makegpr.adb @@ -1058,7 +1058,9 @@ package body Makegpr is Time_Stamp : Time_Stamp_Type; Saved_Last_Argument : Natural; First_Object : Natural; - Discard : Boolean; + + Discard : Boolean; + pragma Warnings (Off, Discard); begin Check_Archive_Builder; @@ -2239,7 +2241,9 @@ package body Makegpr is declare Dep_File : Ada.Text_IO.File_Type; Result : Expect_Match; - Status : Integer; + + Status : Integer; + pragma Warnings (Off, Status); begin -- Create the dependency file diff --git a/gcc/ada/mdll.adb b/gcc/ada/mdll.adb index f2d5aa97578..e6eb5e936a3 100644 --- a/gcc/ada/mdll.adb +++ b/gcc/ada/mdll.adb @@ -111,6 +111,7 @@ package body MDLL is -- Objects plus the export table (.exp) file Success : Boolean; + pragma Warnings (Off, Success); begin if not Quiet then @@ -192,6 +193,7 @@ package body MDLL is procedure Ada_Build_Reloc_DLL is Success : Boolean; + pragma Warnings (Off, Success); begin if not Quiet then @@ -296,6 +298,7 @@ package body MDLL is procedure Build_Non_Reloc_DLL is Success : Boolean; + pragma Warnings (Off, Success); begin if not Quiet then @@ -348,6 +351,7 @@ package body MDLL is procedure Ada_Build_Non_Reloc_DLL is Success : Boolean; + pragma Warnings (Off, Success); begin if not Quiet then diff --git a/gcc/ada/mlib-prj.adb b/gcc/ada/mlib-prj.adb index 4314a80a1d6..2805b8c97a1 100644 --- a/gcc/ada/mlib-prj.adb +++ b/gcc/ada/mlib-prj.adb @@ -1699,7 +1699,8 @@ package body MLib.Prj is -- Designates the full library path name. Either DLL_Name or -- Archive_Name, depending on the library kind. - Success : Boolean := False; + Success : Boolean; + pragma Warnings (Off, Success); -- Used to call Delete_File begin @@ -1774,6 +1775,7 @@ package body MLib.Prj is Last : Natural; Disregard : Boolean; + pragma Warnings (Off, Disregard); DLL_Name : aliased constant String := Lib_Filename.all & "." & DLL_Ext; @@ -1963,6 +1965,7 @@ package body MLib.Prj is Last : Natural; Disregard : Boolean; + pragma Warnings (Off, Disregard); begin Open (Dir, "."); @@ -2181,7 +2184,8 @@ package body MLib.Prj is ---------- procedure Copy (File_Name : File_Name_Type) is - Success : Boolean := False; + Success : Boolean; + pragma Warnings (Off, Success); begin Unit_Loop : diff --git a/gcc/ada/mlib.adb b/gcc/ada/mlib.adb index 573043325e2..b0301d2817c 100644 --- a/gcc/ada/mlib.adb +++ b/gcc/ada/mlib.adb @@ -303,11 +303,11 @@ package body MLib is Newpath : System.Address) return Integer; pragma Import (C, Symlink, "__gnat_symlink"); - Success : Boolean; Version_Path : String_Access; - Result : Integer; - pragma Unreferenced (Result); + Success : Boolean; + Result : Integer; + pragma Unreferenced (Success, Result); begin if Is_Absolute_Path (Lib_Version) then diff --git a/gcc/ada/opt.ads b/gcc/ada/opt.ads index d766e97abbe..00a9cef9076 100644 --- a/gcc/ada/opt.ads +++ b/gcc/ada/opt.ads @@ -36,6 +36,7 @@ -- other GNAT tools. The comments indicate which options are used by which -- programs (GNAT, GNATBIND, GNATLINK, GNATMAKE, GPRMAKE, etc). +with Debug; with Hostparm; use Hostparm; with Types; use Types; @@ -252,8 +253,8 @@ package Opt is -- GNATMAKE, GNATCLEAN, GPRMAKE -- GNATMAKE, GPRMAKE: set to True to skip bind and link steps (except when -- Bind_Only is True). - -- GNATCLEAN: set to True to only the files produced by the compiler are to - -- be deleted, but not the library files or executable files. + -- GNATCLEAN: set to True to delete only the files produced by the compiler + -- but not the library files or the executable files. Config_File : Boolean := True; -- GNAT @@ -601,6 +602,13 @@ package Opt is -- then elaboration flag checks are to be generated in the binder -- generated file. + Inspector_Mode : Boolean renames Debug.Debug_Flag_Dot_II; + -- GNAT + -- True if compiling in inspector mode (-gnatd.I switch). + -- Only relevant when VM_Target /= None. The compiler will attempt to + -- generate code even in case of unsupported construct, so that the byte + -- code can be used by static analysis tools. + Follow_Links : Boolean := False; -- GNATMAKE -- Set to True (-eL) to process the project files in trusted mode @@ -1186,8 +1194,13 @@ package Opt is Warn_On_Modified_Unread : Boolean := False; -- GNAT -- Set to True to generate warnings if a variable is assigned but is never - -- read. The default is that this warning is suppressed. Also controls - -- warnings about assignments whose value is never read. + -- read. The default is that this warning is suppressed. + + Warn_On_Out_Parameter_Unread : Boolean := False; + -- GNAT + -- Set to True to generate warnings if a variable is modified by being + -- passed as to an IN OUT or OUT formal, but the resulting value is never + -- read. The default is that this warning is suppressed. Warn_On_No_Value_Assigned : Boolean := True; -- GNAT diff --git a/gcc/ada/osint.adb b/gcc/ada/osint.adb index ca42b44a918..eb9d23c207e 100644 --- a/gcc/ada/osint.adb +++ b/gcc/ada/osint.adb @@ -295,6 +295,7 @@ package body Osint is Ch : Character; Status : Boolean; + pragma Warnings (Off, Status); -- For the call to Close begin @@ -2042,6 +2043,7 @@ package body Osint is -- Allocated text buffer Status : Boolean; + pragma Warnings (Off, Status); -- For the calls to Close begin @@ -2174,6 +2176,7 @@ package body Osint is Actual_Len : Integer; Status : Boolean; + pragma Warnings (Off, Status); -- For the call to Close begin @@ -2811,6 +2814,7 @@ package body Osint is procedure Write_With_Check (A : Address; N : Integer) is Ignore : Boolean; + pragma Warnings (Off, Ignore); begin if N = Write (Output_FD, A, N) then diff --git a/gcc/ada/par-ch3.adb b/gcc/ada/par-ch3.adb index 265c691ce02..b28c93ea5a7 100644 --- a/gcc/ada/par-ch3.adb +++ b/gcc/ada/par-ch3.adb @@ -4412,7 +4412,7 @@ package body Ch3 is procedure Skip_Declaration (S : List_Id) is Dummy_Done : Boolean; - + pragma Warnings (Off, Dummy_Done); begin P_Declarative_Items (S, Dummy_Done, False); end Skip_Declaration; diff --git a/gcc/ada/prj-makr.adb b/gcc/ada/prj-makr.adb index c07fb267acb..aef87437b88 100644 --- a/gcc/ada/prj-makr.adb +++ b/gcc/ada/prj-makr.adb @@ -937,6 +937,7 @@ package body Prj.Makr is declare Discard : Boolean; + pragma Warnings (Off, Discard); begin Delete_File (Source_List_Path (1 .. Source_List_Last), @@ -1350,6 +1351,7 @@ package body Prj.Makr is declare Discard : Boolean; + pragma Warnings (Off, Discard); begin -- Delete the file if it already exists diff --git a/gcc/ada/prj.adb b/gcc/ada/prj.adb index 5b0ebbb8ebd..0bd6028102c 100644 --- a/gcc/ada/prj.adb +++ b/gcc/ada/prj.adb @@ -364,6 +364,7 @@ package body Prj is procedure Delete_All_Temp_Files is Dont_Care : Boolean; + pragma Warnings (Off, Dont_Care); begin if not Debug.Debug_Flag_N then for Index in 1 .. Temp_Files.Last loop diff --git a/gcc/ada/s-fatgen.adb b/gcc/ada/s-fatgen.adb index f591a699250..20f3ead2828 100644 --- a/gcc/ada/s-fatgen.adb +++ b/gcc/ada/s-fatgen.adb @@ -6,7 +6,7 @@ -- -- -- B o d y -- -- -- --- Copyright (C) 1992-2006, Free Software Foundation, Inc. -- +-- Copyright (C) 1992-2007, 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- -- @@ -129,6 +129,7 @@ package body System.Fat_Gen is function Compose (Fraction : T; Exponent : UI) return T is Arg_Frac : T; Arg_Exp : UI; + pragma Unreferenced (Arg_Exp); begin Decompose (Fraction, Arg_Frac, Arg_Exp); return Scaling (Arg_Frac, Exponent); @@ -251,6 +252,7 @@ package body System.Fat_Gen is function Exponent (X : T) return UI is X_Frac : T; X_Exp : UI; + pragma Unreferenced (X_Frac); begin Decompose (X, X_Frac, X_Exp); return X_Exp; @@ -279,6 +281,7 @@ package body System.Fat_Gen is function Fraction (X : T) return T is X_Frac : T; X_Exp : UI; + pragma Unreferenced (X_Exp); begin Decompose (X, X_Frac, X_Exp); return X_Frac; @@ -451,7 +454,6 @@ package body System.Fat_Gen is B : T; Arg : T; P : T; - Arg_Frac : T; P_Frac : T; Sign_X : T; IEEE_Rem : T; @@ -460,6 +462,9 @@ package body System.Fat_Gen is K : UI; P_Even : Boolean; + Arg_Frac : T; + pragma Unreferenced (Arg_Frac); + begin if Y = 0.0 then raise Constraint_Error; diff --git a/gcc/ada/s-fileio.adb b/gcc/ada/s-fileio.adb index 40a02fb010f..e2c0e3df29c 100644 --- a/gcc/ada/s-fileio.adb +++ b/gcc/ada/s-fileio.adb @@ -523,6 +523,7 @@ package body System.File_IO is return Boolean is V1, V2 : Natural; + pragma Unreferenced (V2); begin Form_Parameter (Form, Keyword, V1, V2); diff --git a/gcc/ada/s-os_lib.adb b/gcc/ada/s-os_lib.adb index d09d9235a73..af4c394b47b 100755 --- a/gcc/ada/s-os_lib.adb +++ b/gcc/ada/s-os_lib.adb @@ -1091,12 +1091,15 @@ package body System.OS_Lib is ------------ function GM_Day (Date : OS_Time) return Day_Type is + D : Day_Type; + + pragma Warnings (Off); Y : Year_Type; Mo : Month_Type; - D : Day_Type; H : Hour_Type; Mn : Minute_Type; S : Second_Type; + pragma Warnings (On); begin GM_Split (Date, Y, Mo, D, H, Mn, S); @@ -1108,12 +1111,15 @@ package body System.OS_Lib is ------------- function GM_Hour (Date : OS_Time) return Hour_Type is + H : Hour_Type; + + pragma Warnings (Off); Y : Year_Type; Mo : Month_Type; D : Day_Type; - H : Hour_Type; Mn : Minute_Type; S : Second_Type; + pragma Warnings (On); begin GM_Split (Date, Y, Mo, D, H, Mn, S); @@ -1125,12 +1131,15 @@ package body System.OS_Lib is --------------- function GM_Minute (Date : OS_Time) return Minute_Type is + Mn : Minute_Type; + + pragma Warnings (Off); Y : Year_Type; Mo : Month_Type; D : Day_Type; H : Hour_Type; - Mn : Minute_Type; S : Second_Type; + pragma Warnings (On); begin GM_Split (Date, Y, Mo, D, H, Mn, S); @@ -1142,12 +1151,15 @@ package body System.OS_Lib is -------------- function GM_Month (Date : OS_Time) return Month_Type is - Y : Year_Type; Mo : Month_Type; + + pragma Warnings (Off); + Y : Year_Type; D : Day_Type; H : Hour_Type; Mn : Minute_Type; S : Second_Type; + pragma Warnings (On); begin GM_Split (Date, Y, Mo, D, H, Mn, S); @@ -1159,12 +1171,15 @@ package body System.OS_Lib is --------------- function GM_Second (Date : OS_Time) return Second_Type is + S : Second_Type; + + pragma Warnings (Off); Y : Year_Type; Mo : Month_Type; D : Day_Type; H : Hour_Type; Mn : Minute_Type; - S : Second_Type; + pragma Warnings (On); begin GM_Split (Date, Y, Mo, D, H, Mn, S); @@ -1226,11 +1241,14 @@ package body System.OS_Lib is function GM_Year (Date : OS_Time) return Year_Type is Y : Year_Type; + + pragma Warnings (Off); Mo : Month_Type; D : Day_Type; H : Hour_Type; Mn : Minute_Type; S : Second_Type; + pragma Warnings (On); begin GM_Split (Date, Y, Mo, D, H, Mn, S); @@ -1464,9 +1482,9 @@ package body System.OS_Lib is (Program_Name : String; Args : Argument_List) return Process_Id is - Junk : Integer; Pid : Process_Id; - + Junk : Integer; + pragma Warnings (Off, Junk); begin Spawn_Internal (Program_Name, Args, Junk, Pid, Blocking => False); return Pid; @@ -2287,8 +2305,9 @@ package body System.OS_Lib is (Program_Name : String; Args : Argument_List) return Integer is - Junk : Process_Id; Result : Integer; + Junk : Process_Id; + pragma Warnings (Off, Junk); begin Spawn_Internal (Program_Name, Args, Result, Junk, Blocking => True); return Result; diff --git a/gcc/ada/s-regpat.adb b/gcc/ada/s-regpat.adb index 2441271f0e5..4204f0cfa06 100755 --- a/gcc/ada/s-regpat.adb +++ b/gcc/ada/s-regpat.adb @@ -2059,8 +2059,12 @@ package body System.Regpat is return Class; end Parse_Posix_Character_Class; + -- Local Declarations + + Result : Pointer; + Expr_Flags : Expression_Flags; - Result : Pointer; + pragma Unreferenced (Expr_Flags); -- Start of processing for Compile @@ -2090,6 +2094,7 @@ package body System.Regpat is is Size : Program_Size; Dummy : Pattern_Matcher (0); + pragma Unreferenced (Dummy); begin Compile (Dummy, Expression, Size, Flags); @@ -2108,6 +2113,7 @@ package body System.Regpat is Flags : Regexp_Flags := No_Flags) is Size : Program_Size; + pragma Unreferenced (Size); begin Compile (Matcher, Expression, Size, Flags); end Compile; @@ -3442,7 +3448,7 @@ package body System.Regpat is is PM : Pattern_Matcher (Size); Finalize_Size : Program_Size; - + pragma Unreferenced (Finalize_Size); begin if Size = 0 then Match (Compile (Expression), Data, Matches, Data_First, Data_Last); @@ -3464,8 +3470,8 @@ package body System.Regpat is Data_Last : Positive := Positive'Last) return Natural is PM : Pattern_Matcher (Size); - Final_Size : Program_Size; -- unused - + Final_Size : Program_Size; + pragma Unreferenced (Final_Size); begin if Size = 0 then return Match (Compile (Expression), Data, Data_First, Data_Last); @@ -3488,8 +3494,8 @@ package body System.Regpat is is Matches : Match_Array (0 .. 0); PM : Pattern_Matcher (Size); - Final_Size : Program_Size; -- unused - + Final_Size : Program_Size; + pragma Unreferenced (Final_Size); begin if Size = 0 then Match (Compile (Expression), Data, Matches, Data_First, Data_Last); diff --git a/gcc/ada/s-taasde.adb b/gcc/ada/s-taasde.adb index f9bcabeeef1..b3e67eeb679 100644 --- a/gcc/ada/s-taasde.adb +++ b/gcc/ada/s-taasde.adb @@ -304,7 +304,7 @@ package body System.Tasking.Async_Delays is task body Timer_Server is function Get_Next_Wakeup_Time return Duration; -- Used to initialize Next_Wakeup_Time, but also to ensure that - -- Make_Independent is called during the elaboration of this task + -- Make_Independent is called during the elaboration of this task. -------------------------- -- Get_Next_Wakeup_Time -- @@ -316,6 +316,8 @@ package body System.Tasking.Async_Delays is return Duration'Last; end Get_Next_Wakeup_Time; + -- Local Declarations + Next_Wakeup_Time : Duration := Get_Next_Wakeup_Time; Timedout : Boolean; Yielded : Boolean; @@ -323,6 +325,8 @@ package body System.Tasking.Async_Delays is Dequeued : Delay_Block_Access; Dequeued_Task : Task_Id; + pragma Unreferenced (Timedout, Yielded); + begin Timer_Server_ID := STPO.Self; @@ -376,7 +380,6 @@ package body System.Tasking.Async_Delays is Timer_Attention := False; Now := STPO.Monotonic_Clock; - while Timer_Queue.Succ.Resume_Time <= Now loop -- Dequeue the waiting task from the front of the queue diff --git a/gcc/ada/s-taprop-mingw.adb b/gcc/ada/s-taprop-mingw.adb index b8ebc814387..d0ba725272d 100644 --- a/gcc/ada/s-taprop-mingw.adb +++ b/gcc/ada/s-taprop-mingw.adb @@ -547,7 +547,9 @@ package body System.Task_Primitives.Operations is Check_Time : Duration := Monotonic_Clock; Rel_Time : Duration; Abs_Time : Duration; - Result : Integer; + + Result : Integer; + pragma Unreferenced (Result); Local_Timedout : Boolean; @@ -607,10 +609,10 @@ package body System.Task_Primitives.Operations is Check_Time : Duration := Monotonic_Clock; Rel_Time : Duration; Abs_Time : Duration; - Timedout : Boolean; - Result : Integer; - pragma Warnings (Off, Integer); + Timedout : Boolean; + Result : Integer; + pragma Unreferenced (Timedout, Result); begin if Single_Lock then diff --git a/gcc/ada/s-taprop-posix.adb b/gcc/ada/s-taprop-posix.adb index e0c35b52b99..f9b30ce69c6 100644 --- a/gcc/ada/s-taprop-posix.adb +++ b/gcc/ada/s-taprop-posix.adb @@ -204,9 +204,11 @@ package body System.Task_Primitives.Operations is pragma Unreferenced (Sig); T : constant Task_Id := Self; - Result : Interfaces.C.int; Old_Set : aliased sigset_t; + Result : Interfaces.C.int; + pragma Warnings (Off, Result); + begin -- It is not safe to raise an exception when using ZCX and the GCC -- exception handling mechanism. diff --git a/gcc/ada/s-taprop-solaris.adb b/gcc/ada/s-taprop-solaris.adb index 26dab87029c..330519db8ea 100644 --- a/gcc/ada/s-taprop-solaris.adb +++ b/gcc/ada/s-taprop-solaris.adb @@ -270,6 +270,7 @@ package body System.Task_Primitives.Operations is Old_Set : aliased sigset_t; Result : Interfaces.C.int; + pragma Warnings (Off, Result); begin -- It is not safe to raise an exception when using ZCX and the GCC diff --git a/gcc/ada/s-taprop-vms.adb b/gcc/ada/s-taprop-vms.adb index 0647b21c981..0440ff3d359 100644 --- a/gcc/ada/s-taprop-vms.adb +++ b/gcc/ada/s-taprop-vms.adb @@ -150,7 +150,8 @@ package body System.Task_Primitives.Operations is -- Signal the condition variable when AST fires procedure Timer_Sleep_AST (ID : Address) is - Result : Interfaces.C.int; + Result : Interfaces.C.int; + pragma Warnings (Off, Result); Self_ID : constant Task_Id := To_Task_Id (ID); begin Self_ID.Common.LL.AST_Pending := False; diff --git a/gcc/ada/s-taprop-vxworks.adb b/gcc/ada/s-taprop-vxworks.adb index 51e7f0cac18..9af031a499a 100644 --- a/gcc/ada/s-taprop-vxworks.adb +++ b/gcc/ada/s-taprop-vxworks.adb @@ -176,9 +176,11 @@ package body System.Task_Primitives.Operations is pragma Unreferenced (signo); Self_ID : constant Task_Id := Self; - Result : int; Old_Set : aliased sigset_t; + Result : int; + pragma Warnings (Off, Result); + begin -- It is not safe to raise an exception when using ZCX and the GCC -- exception handling mechanism. diff --git a/gcc/ada/s-tasdeb.ads b/gcc/ada/s-tasdeb.ads index 72f3954a9d5..9aebe943d4d 100644 --- a/gcc/ada/s-tasdeb.ads +++ b/gcc/ada/s-tasdeb.ads @@ -98,7 +98,7 @@ package System.Tasking.Debug is procedure Stop_All_Tasks_Handler; -- Stop all the tasks by traversing All_Tasks_Lists and calling -- System.Task_Primitives.Operations.Stop_All_Task. This function - -- can be used in a interrupt handler. + -- can be used in an interrupt handler. procedure Stop_All_Tasks; -- Stop all the tasks by traversing All_Tasks_Lists and calling diff --git a/gcc/ada/s-tasren.adb b/gcc/ada/s-tasren.adb index 2af7365554b..40111c8fd3a 100644 --- a/gcc/ada/s-tasren.adb +++ b/gcc/ada/s-tasren.adb @@ -392,6 +392,7 @@ package body System.Tasking.Rendezvous is Uninterpreted_Data : System.Address) is Rendezvous_Successful : Boolean; + pragma Unreferenced (Rendezvous_Successful); begin -- If pragma Detect_Blocking is active then Program_Error must be @@ -1706,7 +1707,9 @@ package body System.Tasking.Rendezvous is Self_Id : constant Task_Id := STPO.Self; Level : ATC_Level; Entry_Call : Entry_Call_Link; - Yielded : Boolean; + + Yielded : Boolean; + pragma Unreferenced (Yielded); begin -- If pragma Detect_Blocking is active then Program_Error must be diff --git a/gcc/ada/s-tassta.adb b/gcc/ada/s-tassta.adb index a50b3795871..ceea9352b3e 100644 --- a/gcc/ada/s-tassta.adb +++ b/gcc/ada/s-tassta.adb @@ -749,7 +749,9 @@ package body System.Tasking.Stages is procedure Finalize_Global_Tasks is Self_ID : constant Task_Id := STPO.Self; + Ignore : Boolean; + pragma Unreferenced (Ignore); begin if Self_ID.Deferral_Level = 0 then diff --git a/gcc/ada/s-tpobop.adb b/gcc/ada/s-tpobop.adb index 25208ad10c0..f034f9e63a5 100644 --- a/gcc/ada/s-tpobop.adb +++ b/gcc/ada/s-tpobop.adb @@ -114,11 +114,10 @@ package body System.Tasking.Protected_Objects.Operations is (Entry_Call : Entry_Call_Link; With_Abort : Boolean); pragma Inline (Update_For_Queue_To_PO); - -- Update the state of an existing entry call to reflect - -- the fact that it is being enqueued, based on - -- whether the current queuing action is with or without abort. - -- Call this only while holding the PO's lock. - -- It returns with the PO's lock still held. + -- Update the state of an existing entry call to reflect the fact that it + -- is being enqueued, based on whether the current queuing action is with + -- or without abort. Call this only while holding the PO's lock. It returns + -- with the PO's lock still held. procedure Requeue_Call (Self_Id : Task_Id; @@ -132,15 +131,16 @@ package body System.Tasking.Protected_Objects.Operations is -- Cancel_Protected_Entry_Call -- --------------------------------- - -- Compiler interface only. Do not call from within the RTS. - -- This should have analogous effect to Cancel_Task_Entry_Call, - -- setting the value of Block.Cancelled instead of returning - -- the parameter value Cancelled. + -- Compiler interface only (do not call from within the RTS) + + -- This should have analogous effect to Cancel_Task_Entry_Call, setting + -- the value of Block.Cancelled instead of returning the parameter value + -- Cancelled. - -- The effect should be idempotent, since the call may already - -- have been dequeued. + -- The effect should be idempotent, since the call may already have been + -- dequeued. - -- source code: + -- Source code: -- select r.e; -- ...A... @@ -148,12 +148,13 @@ package body System.Tasking.Protected_Objects.Operations is -- ...B... -- end select; - -- expanded code: + -- Expanded code: -- declare -- X : protected_entry_index := 1; -- B80b : communication_block; -- communication_blockIP (B80b); + -- begin -- begin -- A79b : label @@ -165,6 +166,7 @@ package body System.Tasking.Protected_Objects.Operations is -- end if; -- return; -- end _clean; + -- begin -- protected_entry_call (rTV!(r)._object'unchecked_access, X, -- null_address, asynchronous_call, B80b, objectF => 0); @@ -174,11 +176,13 @@ package body System.Tasking.Protected_Objects.Operations is -- at end -- _clean; -- end A79b; + -- exception -- when _abort_signal => -- abort_undefer.all; -- null; -- end; + -- if not cancelled (B80b) then -- x := ...A... -- end if; @@ -188,12 +192,12 @@ package body System.Tasking.Protected_Objects.Operations is -- Abort_Signal should be raised and ATC will take us to the at-end -- handler, which will call _clean. - -- If the entry call returns with the call already completed, - -- we can skip this, and use the "if enqueued()" to go past - -- the at-end handler, but we will still call _clean. + -- If the entry call returns with the call already completed, we can skip + -- this, and use the "if enqueued()" to go past the at-end handler, but we + -- will still call _clean. - -- If the abortable part completes before the entry call is Done, - -- it will call _clean. + -- If the abortable part completes before the entry call is Done, it will + -- call _clean. -- If the entry call or the abortable part raises an exception, -- we will still call _clean, but the value of Cancelled should not matter. @@ -201,24 +205,21 @@ package body System.Tasking.Protected_Objects.Operations is -- Whoever calls _clean first gets to decide whether the call -- has been "cancelled". - -- Enqueued should be true if there is any chance that the call - -- is still on a queue. It seems to be safe to make it True if - -- the call was Onqueue at some point before return from - -- Protected_Entry_Call. + -- Enqueued should be true if there is any chance that the call is still on + -- a queue. It seems to be safe to make it True if the call was Onqueue at + -- some point before return from Protected_Entry_Call. -- Cancelled should be true iff the abortable part completed -- and succeeded in cancelling the entry call before it completed. -- ????? - -- The need for Enqueued is less obvious. - -- The "if enqueued ()" tests are not necessary, since both - -- Cancel_Protected_Entry_Call and Protected_Entry_Call must - -- do the same test internally, with locking. The one that - -- makes cancellation conditional may be a useful heuristic - -- since at least 1/2 the time the call should be off-queue - -- by that point. The other one seems totally useless, since - -- Protected_Entry_Call must do the same check and then - -- possibly wait for the call to be abortable, internally. + -- The need for Enqueued is less obvious. The "if enqueued ()" tests are + -- not necessary, since Cancel_Protected_Entry_Call/Protected_Entry_Call + -- must do the same test internally, with locking. The one that makes + -- cancellation conditional may be a useful heuristic since at least 1/2 + -- the time the call should be off-queue by that point. The other one seems + -- totally useless, since Protected_Entry_Call must do the same check and + -- then possibly wait for the call to be abortable, internally. -- We can check Call.State here without locking the caller's mutex, -- since the call must be over after returning from Wait_For_Completion. @@ -277,15 +278,17 @@ package body System.Tasking.Protected_Objects.Operations is pragma Debug (Debug.Trace (STPO.Self, "Exceptional_Complete_Entry_Body", 'P')); - -- We must have abort deferred, since we are inside - -- a protected operation. + -- We must have abort deferred, since we are inside a protected + -- operation. if Entry_Call /= null then - -- The call was not requeued. + + -- The call was not requeued Entry_Call.Exception_To_Raise := Ex; if Ex /= Ada.Exceptions.Null_Id then + -- An exception was raised and abort was deferred, so adjust -- before propagating, otherwise the task will stay with deferral -- enabled for its remaining life. @@ -299,6 +302,7 @@ package body System.Tasking.Protected_Objects.Operations is -- Wakeup_Entry_Caller will be called from PO_Do_Or_Queue or -- PO_Service_Entries on return. + end if; if Runtime_Traces then @@ -331,7 +335,7 @@ package body System.Tasking.Protected_Objects.Operations is if Barrier_Value then - -- Not abortable while service is in progress. + -- Not abortable while service is in progress if Entry_Call.State = Now_Abortable then Entry_Call.State := Was_Abortable; @@ -439,7 +443,7 @@ package body System.Tasking.Protected_Objects.Operations is E := Protected_Entry_Index (Entry_Call.E); - -- Not abortable while service is in progress. + -- Not abortable while service is in progress if Entry_Call.State = Now_Abortable then Entry_Call.State := Was_Abortable; @@ -454,10 +458,12 @@ package body System.Tasking.Protected_Objects.Operations is end if; pragma Debug - (Debug.Trace (Self_ID, "POSE: start entry body", 'P')); - Object.Entry_Bodies ( - Object.Find_Body_Index (Object.Compiler_Info, E)).Action ( - Object.Compiler_Info, Entry_Call.Uninterpreted_Data, E); + (Debug.Trace (Self_ID, "POSE: start entry body", 'P')); + + Object.Entry_Bodies + (Object.Find_Body_Index (Object.Compiler_Info, E)).Action + (Object.Compiler_Info, Entry_Call.Uninterpreted_Data, E); + exception when others => Queuing.Broadcast_Program_Error @@ -497,8 +503,7 @@ package body System.Tasking.Protected_Objects.Operations is function Protected_Count (Object : Protection_Entries'Class; - E : Protected_Entry_Index) - return Natural + E : Protected_Entry_Index) return Natural is begin return Queuing.Count_Waiting (Object.Entry_Queues (E)); @@ -508,7 +513,7 @@ package body System.Tasking.Protected_Objects.Operations is -- Protected_Entry_Call -- -------------------------- - -- Compiler interface only. Do not call from within the RTS. + -- Compiler interface only (do not call from within the RTS) -- select r.e; -- ...A... @@ -520,9 +525,11 @@ package body System.Tasking.Protected_Objects.Operations is -- X : protected_entry_index := 1; -- B85b : communication_block; -- communication_blockIP (B85b); + -- begin -- protected_entry_call (rTV!(r)._object'unchecked_access, X, -- null_address, conditional_call, B85b, objectF => 0); + -- if cancelled (B85b) then -- ...B... -- else @@ -636,7 +643,7 @@ package body System.Tasking.Protected_Objects.Operations is if Entry_Call.State >= Done then - -- Once State >= Done it will not change any more. + -- Once State >= Done it will not change any more if Single_Lock then STPO.Lock_RTS; @@ -657,16 +664,17 @@ package body System.Tasking.Protected_Objects.Operations is return; else - -- In this case we cannot conclude anything, - -- since State can change concurrently. + -- In this case we cannot conclude anything, since State can change + -- concurrently. + null; end if; - -- Now for the general case. + -- Now for the general case if Mode = Asynchronous_Call then - -- Try to avoid an expensive call. + -- Try to avoid an expensive call if not Initially_Abortable then if Single_Lock then @@ -686,6 +694,7 @@ package body System.Tasking.Protected_Objects.Operations is STPO.Lock_RTS; Entry_Calls.Wait_For_Completion (Entry_Call); STPO.Unlock_RTS; + else STPO.Write_Lock (Self_ID); Entry_Calls.Wait_For_Completion (Entry_Call); @@ -750,8 +759,7 @@ package body System.Tasking.Protected_Objects.Operations is if Ceiling_Violation then Object.Call_In_Progress := null; - Queuing.Broadcast_Program_Error - (Self_Id, Object, Entry_Call); + Queuing.Broadcast_Program_Error (Self_Id, Object, Entry_Call); else PO_Do_Or_Queue (Self_Id, New_Object, Entry_Call); @@ -761,17 +769,17 @@ package body System.Tasking.Protected_Objects.Operations is else -- Requeue is to same protected object - -- ??? Try to compensate apparent failure of the - -- scheduler on some OS (e.g VxWorks) to give higher - -- priority tasks a chance to run (see CXD6002). + -- ??? Try to compensate apparent failure of the scheduler on some + -- OS (e.g VxWorks) to give higher priority tasks a chance to run + -- (see CXD6002). STPO.Yield (False); if Entry_Call.With_Abort and then Entry_Call.Cancellation_Attempted then - -- If this is a requeue with abort and someone tried - -- to cancel this call, cancel it at this point. + -- If this is a requeue with abort and someone tried to cancel + -- this call, cancel it at this point. Entry_Call.State := Cancelled; return; @@ -804,6 +812,7 @@ package body System.Tasking.Protected_Objects.Operations is if Single_Lock then STPO.Unlock_RTS; end if; + else Queuing.Enqueue (New_Object.Entry_Queues (E), Entry_Call); @@ -831,7 +840,7 @@ package body System.Tasking.Protected_Objects.Operations is -- Requeue_Protected_Entry -- ----------------------------- - -- Compiler interface only. Do not call from within the RTS. + -- Compiler interface only (do not call from within the RTS) -- entry e when b is -- begin @@ -893,7 +902,7 @@ package body System.Tasking.Protected_Objects.Operations is -- Requeue_Task_To_Protected_Entry -- ------------------------------------- - -- Compiler interface only. + -- Compiler interface only (do not call from within the RTS) -- accept e1 do -- ...A... @@ -902,6 +911,7 @@ package body System.Tasking.Protected_Objects.Operations is -- A79b : address; -- L78b : label + -- begin -- accept_call (1, A79b); -- ...A... @@ -910,6 +920,7 @@ package body System.Tasking.Protected_Objects.Operations is -- goto L78b; -- <<L78b>> -- complete_rendezvous; + -- exception -- when all others => -- exceptional_complete_rendezvous (get_gnat_exception); @@ -951,7 +962,7 @@ package body System.Tasking.Protected_Objects.Operations is -- Timed_Protected_Entry_Call -- -------------------------------- - -- Compiler interface only. Do not call from within the RTS. + -- Compiler interface only (do not call from within the RTS) procedure Timed_Protected_Entry_Call (Object : Protection_Entries_Access; @@ -964,7 +975,9 @@ package body System.Tasking.Protected_Objects.Operations is Self_Id : constant Task_Id := STPO.Self; Entry_Call : Entry_Call_Link; Ceiling_Violation : Boolean; - Yielded : Boolean; + + Yielded : Boolean; + pragma Unreferenced (Yielded); begin if Self_Id.ATC_Nesting_Level = ATC_Level'Last then @@ -1028,7 +1041,7 @@ package body System.Tasking.Protected_Objects.Operations is STPO.Write_Lock (Self_Id); end if; - -- Try to avoid waiting for completed or cancelled calls. + -- Try to avoid waiting for completed or cancelled calls if Entry_Call.State >= Done then Utilities.Exit_One_ATC_Level (Self_Id); diff --git a/gcc/ada/s-tposen.adb b/gcc/ada/s-tposen.adb index 38554fa53e3..aeee03684b4 100644 --- a/gcc/ada/s-tposen.adb +++ b/gcc/ada/s-tposen.adb @@ -211,7 +211,9 @@ package body System.Tasking.Protected_Objects.Single_Entry is is Self_Id : constant Task_Id := Entry_Call.Self; Timedout : Boolean; + Yielded : Boolean; + pragma Unreferenced (Yielded); use type Ada.Exceptions.Exception_Id; @@ -663,7 +665,7 @@ package body System.Tasking.Protected_Objects.Single_Entry is -- Timed_Protected_Single_Entry_Call -- --------------------------------------- - -- Compiler interface only. Do not call from within the RTS. + -- Compiler interface only (do not call from within the RTS) procedure Timed_Protected_Single_Entry_Call (Object : Protection_Entry_Access; diff --git a/gcc/ada/sem_ch11.adb b/gcc/ada/sem_ch11.adb index f6ce93d5443..66cfc88a993 100644 --- a/gcc/ada/sem_ch11.adb +++ b/gcc/ada/sem_ch11.adb @@ -534,6 +534,8 @@ package body Sem_Ch11 is Analyze_And_Resolve (Expression (N), Standard_String); end if; end if; + + Kill_Current_Values (Last_Assignment_Only => True); end Analyze_Raise_Statement; ----------------------------- diff --git a/gcc/ada/sem_ch5.adb b/gcc/ada/sem_ch5.adb index 25e5889815d..553f20040cb 100644 --- a/gcc/ada/sem_ch5.adb +++ b/gcc/ada/sem_ch5.adb @@ -707,8 +707,11 @@ package body Sem_Ch5 is -- generate bogus warnings when an assignment is rewritten as -- another assignment, and gets tied up with itself. + -- Note: we don't use Record_Last_Assignment here, because we + -- have lots of other stuff to do under control of this test. + if Warn_On_Modified_Unread - and then Ekind (Ent) = E_Variable + and then Is_Assignable (Ent) and then Comes_From_Source (N) and then In_Extended_Main_Source_Unit (Ent) then @@ -884,6 +887,10 @@ package body Sem_Ch5 is Dont_Care : Boolean; Others_Present : Boolean; + pragma Warnings (Off, Last_Choice); + pragma Warnings (Off, Dont_Care); + -- Don't care about assigned values + Statements_Analyzed : Boolean := False; -- Set True if at least some statement sequences get analyzed. -- If False on exit, means we had a serious error that prevented @@ -981,6 +988,7 @@ package body Sem_Ch5 is -- a call to Number_Of_Choices to get the right number of entries. Case_Table : Choice_Table_Type (1 .. Number_Of_Choices (N)); + pragma Warnings (Off, Case_Table); -- Start of processing for Analyze_Case_Statement @@ -1171,6 +1179,7 @@ package body Sem_Ch5 is begin Check_Unreachable_Code (N); + Kill_Current_Values (Last_Assignment_Only => True); Analyze (Label); Label_Ent := Entity (Label); @@ -1771,6 +1780,8 @@ package body Sem_Ch5 is Hhi : Uint; HOK : Boolean; + pragma Warnings (Off, Hlo); + begin Determine_Range (L, LOK, Llo, Lhi); Determine_Range (H, HOK, Hlo, Hhi); diff --git a/gcc/ada/sem_ch7.adb b/gcc/ada/sem_ch7.adb index 40dceb2a2c2..e7076b34e50 100644 --- a/gcc/ada/sem_ch7.adb +++ b/gcc/ada/sem_ch7.adb @@ -808,7 +808,7 @@ package body Sem_Ch7 is E := FE; while Present (E) and then E /= Id loop - if Ekind (E) = E_Variable then + if Is_Assignable (E) then Set_Never_Set_In_Source (E, False); Set_Is_True_Constant (E, False); Set_Current_Value (E, Empty); diff --git a/gcc/ada/sem_ch8.adb b/gcc/ada/sem_ch8.adb index fff20546516..8a5ae003e5f 100644 --- a/gcc/ada/sem_ch8.adb +++ b/gcc/ada/sem_ch8.adb @@ -3014,6 +3014,15 @@ package body Sem_Ch8 is -- entity requires special handling because it may be use-visible -- but hides directly visible entities defined outside the instance. + function Is_Actual_Parameter return Boolean; + -- This function checks if the node N is an identifier that is an actual + -- parameter of a procedure call. If so it returns True, otherwise it + -- return False. The reason for this check is that at this stage we do + -- not know what procedure is being called if the procedure might be + -- overloaded, so it is premature to go setting referenced flags or + -- making calls to Generate_Reference. We will wait till Resolve_Actuals + -- for that processing + function Known_But_Invisible (E : Entity_Id) return Boolean; -- This function determines whether the entity E (which is not -- visible) can reasonably be considered to be known to the writer @@ -3094,6 +3103,23 @@ package body Sem_Ch8 is end From_Actual_Package; ------------------------- + -- Is_Actual_Parameter -- + ------------------------- + + function Is_Actual_Parameter return Boolean is + begin + return + Nkind (N) = N_Identifier + and then + (Nkind (Parent (N)) = N_Procedure_Call_Statement + or else + (Nkind (Parent (N)) = N_Parameter_Association + and then N = Explicit_Actual_Parameter (Parent (N)) + and then Nkind (Parent (Parent (N))) = + N_Procedure_Call_Statement)); + end Is_Actual_Parameter; + + ------------------------- -- Known_But_Invisible -- ------------------------- @@ -3837,7 +3863,9 @@ package body Sem_Ch8 is -- If no homonyms were visible, the entity is unambiguous if not Is_Overloaded (N) then - Generate_Reference (E, N); + if not Is_Actual_Parameter then + Generate_Reference (E, N); + end if; end if; -- Case of non-overloadable entity, set the entity providing that @@ -3856,10 +3884,11 @@ package body Sem_Ch8 is if Nkind (Parent (N)) = N_Label then declare R : constant Boolean := Referenced (E); - begin - Generate_Reference (E, N); - Set_Referenced (E, R); + if not Is_Actual_Parameter then + Generate_Reference (E, N); + Set_Referenced (E, R); + end if; end; -- Normal case, not a label: generate reference @@ -3870,9 +3899,15 @@ package body Sem_Ch8 is -- determine whether this reference modifies the denoted object -- (because implicit derefences cannot be identified prior to -- full type resolution). + -- + -- ??? The Is_Actual_Parameter routine takes care of one of these + -- cases but there are others probably else - Generate_Reference (E, N); + if not Is_Actual_Parameter then + Generate_Reference (E, N); + end if; + Check_Nested_Access (E); end if; diff --git a/gcc/ada/sem_prag.adb b/gcc/ada/sem_prag.adb index 71a3da2fa0d..65ee2870de5 100644 --- a/gcc/ada/sem_prag.adb +++ b/gcc/ada/sem_prag.adb @@ -5519,6 +5519,8 @@ package body Sem_Prag is when Pragma_Convention => Convention : declare C : Convention_Id; E : Entity_Id; + pragma Warnings (Off, C); + pragma Warnings (Off, E); begin Check_Arg_Order ((Name_Convention, Name_Entity)); Check_Ada_83_Warning; @@ -6151,6 +6153,8 @@ package body Sem_Prag is C : Convention_Id; Def_Id : Entity_Id; + pragma Warnings (Off, C); + begin Check_Ada_83_Warning; Check_Arg_Order @@ -6540,8 +6544,11 @@ package body Sem_Prag is -- [, [Link_Name =>] static_string_EXPRESSION ]); when Pragma_External => External : declare - C : Convention_Id; - Def_Id : Entity_Id; + Def_Id : Entity_Id; + + C : Convention_Id; + pragma Warnings (Off, C); + begin GNAT_Pragma; Check_Arg_Order diff --git a/gcc/ada/sem_res.adb b/gcc/ada/sem_res.adb index 718fb242e08..258064aa20d 100644 --- a/gcc/ada/sem_res.adb +++ b/gcc/ada/sem_res.adb @@ -116,6 +116,10 @@ package body Sem_Res is -- initialization of individual components within the init proc itself. -- Could be optimized away perhaps? + function Is_Definite_Access_Type (E : Entity_Id) return Boolean; + -- Determine whether E is an access type declared by an access + -- declaration, and not an (anonymous) allocator type. + function Is_Predefined_Op (Nam : Entity_Id) return Boolean; -- Utility to check whether the name in the call is a predefined -- operator, in which case the call is made into an operator node. @@ -989,6 +993,18 @@ package body Sem_Res is end if; end Check_Parameterless_Call; + ----------------------------- + -- Is_Definite_Access_Type -- + ----------------------------- + + function Is_Definite_Access_Type (E : Entity_Id) return Boolean is + Btyp : constant Entity_Id := Base_Type (E); + begin + return Ekind (Btyp) = E_Access_Type + or else (Ekind (Btyp) = E_Access_Subprogram_Type + and then Comes_From_Source (Btyp)); + end Is_Definite_Access_Type; + ---------------------- -- Is_Predefined_Op -- ---------------------- @@ -1024,10 +1040,6 @@ package body Sem_Res is type Kind_Test is access function (E : Entity_Id) return Boolean; - function Is_Definite_Access_Type (E : Entity_Id) return Boolean; - -- Determine whether E is an access type declared by an access decla- - -- ration, and not an (anonymous) allocator type. - function Operand_Type_In_Scope (S : Entity_Id) return Boolean; -- If the operand is not universal, and the operator is given by a -- expanded name, verify that the operand has an interpretation with @@ -1037,18 +1049,6 @@ package body Sem_Res is -- Find a type of the given class in the package Pack that contains -- the operator. - ----------------------------- - -- Is_Definite_Access_Type -- - ----------------------------- - - function Is_Definite_Access_Type (E : Entity_Id) return Boolean is - Btyp : constant Entity_Id := Base_Type (E); - begin - return Ekind (Btyp) = E_Access_Type - or else (Ekind (Btyp) = E_Access_Subprogram_Type - and then Comes_From_Source (Btyp)); - end Is_Definite_Access_Type; - --------------------------- -- Operand_Type_In_Scope -- --------------------------- @@ -2568,6 +2568,7 @@ package body Sem_Res is A_Typ : Entity_Id; F_Typ : Entity_Id; Prev : Node_Id := Empty; + Orig_A : Node_Id; procedure Check_Prefixed_Call; -- If the original node is an overloaded call in prefix notation, @@ -3042,10 +3043,44 @@ package body Sem_Res is end if; end if; - if Ekind (F) /= E_In_Parameter - and then not Is_OK_Variable_For_Out_Formal (A) - then - Error_Msg_NE ("actual for& must be a variable", A, F); + -- For IN parameter, this is where we generate a reference after + -- resolution is complete. + + if Ekind (F) = E_In_Parameter then + Orig_A := Original_Node (A); + + if Is_Entity_Name (Orig_A) + and then Present (Entity (Orig_A)) + then + Generate_Reference (Entity (Orig_A), Orig_A); + end if; + + -- Case of OUT or IN OUT parameter + + else + -- Validate the form of the actual. Note that the call to + -- Is_OK_Variable_For_Out_Formal generates the required + -- reference in this case. + + if not Is_OK_Variable_For_Out_Formal (A) then + Error_Msg_NE ("actual for& must be a variable", A, F); + end if; + + -- For an Out parameter, check for useless assignment. Note + -- that we can't set Last_Assignment this early, because we + -- may kill current values in Resolve_Call, and that call + -- would clobber the Last_Assignment field. + + if Ekind (F) = E_Out_Parameter then + if Warn_On_Out_Parameter_Unread + and then Is_Entity_Name (A) + and then Present (Entity (A)) + then + Warn_On_Useless_Assignment (Entity (A), Sloc (A)); + end if; + end if; + + -- What's the following about??? if Is_Entity_Name (A) then Kill_Checks (Entity (A)); @@ -4774,6 +4809,37 @@ package body Sem_Res is Kill_Current_Values; end if; + -- If we are warning about unread out parameters, this is the place to + -- set Last_Assignment for out parameters. We have to do this after the + -- above call to Kill_Current_Values (since that call clears the + -- Last_Assignment field of all local variables). + + if Warn_On_Out_Parameter_Unread + and then Comes_From_Source (N) + and then In_Extended_Main_Source_Unit (N) + then + declare + F : Entity_Id; + A : Node_Id; + + begin + F := First_Formal (Nam); + A := First_Actual (N); + while Present (F) and then Present (A) loop + if Ekind (F) = E_Out_Parameter + and then Is_Entity_Name (A) + and then Present (Entity (A)) + and then Safe_To_Capture_Value (N, Entity (A)) + then + Set_Last_Assignment (Entity (A), A); + end if; + + Next_Formal (F); + Next_Actual (A); + end loop; + end; + end if; + -- If the subprogram is a primitive operation, check whether or not -- it is a correct dispatching call. @@ -4804,6 +4870,8 @@ package body Sem_Res is Check_Intrinsic_Call (N); end if; + -- All done, evaluate call and deal with elaboration issues + Eval_Call (N); Check_Elab_Call (N); end Resolve_Call; diff --git a/gcc/ada/sem_type.adb b/gcc/ada/sem_type.adb index 3b9f57de48d..4612ad36517 100644 --- a/gcc/ada/sem_type.adb +++ b/gcc/ada/sem_type.adb @@ -494,10 +494,13 @@ package body Sem_Type is and then Is_Overloaded (Name (N)) then declare - I : Interp_Index; It : Interp; + + Itn : Interp_Index; + pragma Warnings (Off, Itn); + begin - Get_First_Interp (Name (N), I, It); + Get_First_Interp (Name (N), Itn, It); Add_Entry (It.Nam, Etype (N)); end; diff --git a/gcc/ada/sem_util.adb b/gcc/ada/sem_util.adb index a9d4aec18c6..a6c35d3e9ef 100644 --- a/gcc/ada/sem_util.adb +++ b/gcc/ada/sem_util.adb @@ -2192,6 +2192,9 @@ package body Sem_Util is if Dynamic_Scope = Standard_Standard then return Empty; + elsif Dynamic_Scope = Empty then + return Empty; + elsif Ekind (Dynamic_Scope) = E_Subprogram_Body then return Corresponding_Spec (Parent (Parent (Dynamic_Scope))); @@ -2629,6 +2632,69 @@ package body Sem_Util is end if; end Explain_Limited_Type; + ---------------------- + -- Find_Actual_Mode -- + ---------------------- + + procedure Find_Actual_Mode + (N : Node_Id; + Kind : out Entity_Kind; + Call : out Node_Id) + is + Parnt : constant Node_Id := Parent (N); + Formal : Entity_Id; + Actual : Node_Id; + + begin + if (Nkind (Parnt) = N_Indexed_Component + or else + Nkind (Parnt) = N_Selected_Component) + and then N = Prefix (Parnt) + then + Find_Actual_Mode (Parnt, Kind, Call); + return; + + elsif Nkind (Parnt) = N_Parameter_Association + and then N = Explicit_Actual_Parameter (Parnt) + then + Call := Parent (Parnt); + + elsif Nkind (Parnt) = N_Procedure_Call_Statement then + Call := Parnt; + + else + Kind := E_Void; + Call := Empty; + return; + end if; + + -- If we have a call to a subprogram look for the parametere + + if Is_Entity_Name (Name (Call)) + and then Present (Entity (Name (Call))) + and then Is_Overloadable (Entity (Name (Call))) + then + -- Fall here if we are definitely a parameter + + Actual := First_Actual (Call); + Formal := First_Formal (Entity (Name (Call))); + while Present (Formal) and then Present (Actual) loop + if Actual = N then + Kind := Ekind (Formal); + return; + else + Actual := Next_Actual (Actual); + Formal := Next_Formal (Formal); + end if; + end loop; + end if; + + -- Fall through here if we did not find matching actual + + Kind := E_Void; + Call := Empty; + end Find_Actual_Mode; + ------------------------------------- -- Find_Corresponding_Discriminant -- ------------------------------------- @@ -5827,7 +5893,9 @@ package body Sem_Util is Comp_List : Node_Id; Discr : Entity_Id; Discr_Val : Node_Id; + Report_Errors : Boolean; + pragma Warnings (Off, Report_Errors); begin if Serious_Errors_Detected > 0 then @@ -6923,16 +6991,19 @@ package body Sem_Util is -- Kill_Current_Values -- ------------------------- - procedure Kill_Current_Values (Ent : Entity_Id) is + procedure Kill_Current_Values + (Ent : Entity_Id; + Last_Assignment_Only : Boolean := False) + is begin - if Is_Object (Ent) then + if Is_Assignable (Ent) then + Set_Last_Assignment (Ent, Empty); + end if; + + if not Last_Assignment_Only and then Is_Object (Ent) then Kill_Checks (Ent); Set_Current_Value (Ent, Empty); - if Ekind (Ent) = E_Variable then - Set_Last_Assignment (Ent, Empty); - end if; - if not Can_Never_Be_Null (Ent) then Set_Is_Known_Non_Null (Ent, False); end if; @@ -6941,7 +7012,7 @@ package body Sem_Util is end if; end Kill_Current_Values; - procedure Kill_Current_Values is + procedure Kill_Current_Values (Last_Assignment_Only : Boolean := False) is S : Entity_Id; procedure Kill_Current_Values_For_Entity_Chain (E : Entity_Id); @@ -6956,7 +7027,7 @@ package body Sem_Util is begin Ent := E; while Present (Ent) loop - Kill_Current_Values (Ent); + Kill_Current_Values (Ent, Last_Assignment_Only); Next_Entity (Ent); end loop; end Kill_Current_Values_For_Entity_Chain; @@ -6966,7 +7037,9 @@ package body Sem_Util is begin -- Kill all saved checks, a special case of killing saved values - Kill_All_Checks; + if not Last_Assignment_Only then + Kill_All_Checks; + end if; -- Loop through relevant scopes, which includes the current scope and -- any parent scopes if the current scope is a block or a package. @@ -7766,8 +7839,8 @@ package body Sem_Util is and then Nkind (Expression (Parent (Entity (P)))) = N_Reference then - -- Case of a reference to a value on which - -- side effects have been removed. + -- Case of a reference to a value on which side effects have + -- been removed. Exp := Prefix (Expression (Parent (Entity (P)))); goto Continue; diff --git a/gcc/ada/sem_util.ads b/gcc/ada/sem_util.ads index c0ce298befa..1e023252b56 100644 --- a/gcc/ada/sem_util.ads +++ b/gcc/ada/sem_util.ads @@ -283,6 +283,17 @@ package Sem_Util is -- adds additional continuation lines to the message explaining -- why type T is limited. Messages are placed at node N. + procedure Find_Actual_Mode + (N : Node_Id; + Kind : out Entity_Kind; + Call : out Node_Id); + -- Determines if the node N is an actual parameter of a procedure call. If + -- so, then Kind is E_In_Parameter, E_Out_Parameter, E_In_Out_Parameter on + -- return as appropriate, and Call is set to the node for the corresponding + -- call. If the node N is not an actual parameter, then Kind = E_Void, Call + -- = Empty. Note that this only applies to procedure calls, for function + -- calls, the result is always E_Void. + function Find_Corresponding_Discriminant (Id : Node_Id; Typ : Entity_Id) return Entity_Id; @@ -743,7 +754,7 @@ package Sem_Util is -- here is for something actually declared as volatile, not for an object -- that gets treated as volatile (see Einfo.Treat_As_Volatile). - procedure Kill_Current_Values; + procedure Kill_Current_Values (Last_Assignment_Only : Boolean := False); -- This procedure is called to clear all constant indications from all -- entities in the current scope and in any parent scopes if the current -- scope is a block or a package (and that recursion continues to the top @@ -756,11 +767,24 @@ package Sem_Util is -- Kill_All_Checks, since this is a special case of needing to forget saved -- values. This procedure also clears Is_Known_Non_Null flags in variables, -- constants or parameters since these are also not known to be valid. - - procedure Kill_Current_Values (Ent : Entity_Id); + -- + -- The Last_Assignment_Only flag is set True to clear only Last_Assignment + -- fields and leave other fields unchanged. This is used when we encounter + -- an unconditional flow of control change (return, goto, raise). In such + -- cases we don't need to clear the current values, since it may be that + -- the flow of control change occurs in a conditional context, and if it + -- is not taken, then it is just fine to keep the current values. But the + -- Last_Assignment field is different, if we have a sequence assign-to-v, + -- conditional-return, assign-to-v, we do not want to complain that the + -- second assignment clobbers the first. + + procedure Kill_Current_Values + (Ent : Entity_Id; + Last_Assignment_Only : Boolean := False); -- This performs the same processing as described above for the form with -- no argument, but for the specific entity given. The call has no effect - -- if the entity Ent is not for an object. + -- if the entity Ent is not for an object. Again, Last_Assignment_Only is + -- set if you want to clear only the Last_Assignment field (see above). procedure Kill_Size_Check_Code (E : Entity_Id); -- Called when an address clause or pragma Import is applied to an diff --git a/gcc/ada/sem_warn.adb b/gcc/ada/sem_warn.adb index 3faf9cb09d6..65ea957c744 100644 --- a/gcc/ada/sem_warn.adb +++ b/gcc/ada/sem_warn.adb @@ -1119,8 +1119,9 @@ package body Sem_Warn is or else (Check_Unreferenced_Formals and then Is_Formal (E1)) or else - (Warn_On_Modified_Unread - and then Referenced_As_LHS_Check_Spec (E1))) + ((Warn_On_Modified_Unread + or Warn_On_Out_Parameter_Unread) + and then Referenced_As_LHS_Check_Spec (E1))) -- Labels, and enumeration literals, and exceptions. The -- warnings are also placed on local packages that cannot be @@ -2529,6 +2530,12 @@ package body Sem_Warn is when 'C' => Warn_On_Unrepped_Components := False; + when 'o' => + Warn_On_Out_Parameter_Unread := True; + + when 'O' => + Warn_On_Out_Parameter_Unread := False; + when 'r' => Warn_On_Object_Renames_Function := True; @@ -2597,6 +2604,7 @@ package body Sem_Warn is Warn_On_No_Value_Assigned := False; Warn_On_Non_Local_Exception := False; Warn_On_Obsolescent_Feature := False; + Warn_On_Out_Parameter_Unread := False; Warn_On_Questionable_Missing_Parens := False; Warn_On_Redundant_Constructs := False; Warn_On_Object_Renames_Function := False; @@ -3256,6 +3264,7 @@ package body Sem_Warn is Body_E : Entity_Id := Empty) is E : Entity_Id := Spec_E; + begin if not Referenced_Check_Spec (E) and then not Warnings_Off (E) then case Ekind (E) is @@ -3269,7 +3278,7 @@ package body Sem_Warn is and then No (Address_Clause (E)) and then not Is_Volatile (E) then - if Warn_On_Modified_Unread + if (Warn_On_Modified_Unread or Warn_On_Out_Parameter_Unread) and then not Is_Imported (E) and then not Is_Return_Object (E) @@ -3425,7 +3434,7 @@ package body Sem_Warn is -- last assignment field set, with warnings enabled, and which is -- not imported or exported. - if Ekind (Ent) = E_Variable + if Is_Assignable (Ent) and then not Is_Return_Object (Ent) and then Present (Last_Assignment (Ent)) and then not Warnings_Off (Ent) @@ -3451,10 +3460,21 @@ package body Sem_Warn is elsif Nkind (P) = N_Subprogram_Body or else Nkind (P) = N_Package_Body then + -- Case of assigned value never referenced + if Loc = No_Location then - Error_Msg_NE - ("?useless assignment to&, value never referenced!", - Last_Assignment (Ent), Ent); + + -- Don't give this for OUT and IN OUT formals, since + -- clearly caller may reference the assigned value. + + if Ekind (Ent) = E_Variable then + Error_Msg_NE + ("?useless assignment to&, value never referenced!", + Last_Assignment (Ent), Ent); + end if; + + -- Case of assigned value overwritten + else Error_Msg_Sloc := Loc; Error_Msg_NE @@ -3462,6 +3482,8 @@ package body Sem_Warn is Last_Assignment (Ent), Ent); end if; + -- Clear last assignment indication and we are done + Set_Last_Assignment (Ent, Empty); return; diff --git a/gcc/ada/sem_warn.ads b/gcc/ada/sem_warn.ads index fa0bf53e70d..23618d105c2 100644 --- a/gcc/ada/sem_warn.ads +++ b/gcc/ada/sem_warn.ads @@ -179,10 +179,11 @@ package Sem_Warn is Loc : Source_Ptr := No_Location); -- Called to check if we have a case of a useless assignment to the given -- entity Ent, as indicated by a non-empty Last_Assignment field. This call - -- should only be made if Warn_On_Modified_Unread is True, and if Ent is in - -- the extended main source unit. Loc is No_Location for the end of block - -- call (warning msg says value unreferenced), or the it is the location of - -- an overwriting assignment (warning msg points to this assignment). + -- should only be made if at least one of the flags Warn_On_Modified_Unread + -- or Warn_On_Out_Parameter_Unread is True, and if Ent is in the extended + -- main source unit. Loc is No_Location for the end of block call (warning + -- message says value unreferenced), or the it is the location of an + -- overwriting assignment (warning message points to this assignment). procedure Warn_On_Useless_Assignments (E : Entity_Id); pragma Inline (Warn_On_Useless_Assignments); diff --git a/gcc/ada/sinfo.ads b/gcc/ada/sinfo.ads index 8528156dd9e..61a1400369e 100644 --- a/gcc/ada/sinfo.ads +++ b/gcc/ada/sinfo.ads @@ -3672,10 +3672,10 @@ package Sinfo is -- N_Allocator -- Sloc points to NEW -- Expression (Node3) subtype indication or qualified expression - -- Null_Exclusion_Present (Flag11) -- Storage_Pool (Node1-Sem) -- Procedure_To_Call (Node2-Sem) -- Coextensions (Elist4-Sem) + -- Null_Exclusion_Present (Flag11) -- No_Initialization (Flag13-Sem) -- Is_Static_Coextension (Flag14-Sem) -- Do_Storage_Check (Flag17-Sem) diff --git a/gcc/ada/sinput-d.adb b/gcc/ada/sinput-d.adb index ba9a3dfc921..a860058c900 100644 --- a/gcc/ada/sinput-d.adb +++ b/gcc/ada/sinput-d.adb @@ -39,6 +39,8 @@ package body Sinput.D is S : Source_File_Record renames Source_File.Table (Dfile); Src : Source_Buffer_Ptr; + pragma Warnings (Off, S); + begin Trim_Lines_Table (Dfile); Close_Debug_File; diff --git a/gcc/ada/stylesw.adb b/gcc/ada/stylesw.adb index 13df44dacd3..a6cd38c591b 100644 --- a/gcc/ada/stylesw.adb +++ b/gcc/ada/stylesw.adb @@ -180,6 +180,7 @@ package body Stylesw is procedure Set_Style_Check_Options (Options : String) is OK : Boolean; EC : Natural; + pragma Warnings (Off, EC); begin Set_Style_Check_Options (Options, OK, EC); pragma Assert (OK); diff --git a/gcc/ada/symbols-vms.adb b/gcc/ada/symbols-vms.adb index f3b5aea3d68..39c9beb3202 100644 --- a/gcc/ada/symbols-vms.adb +++ b/gcc/ada/symbols-vms.adb @@ -103,7 +103,6 @@ package body Symbols is begin if Result (Result'First) = ' ' then return Result (Result'First + 1 .. Result'Last); - else return Result; end if; diff --git a/gcc/ada/types.ads b/gcc/ada/types.ads index 2bfc91e2a86..61318c8bcb8 100644 --- a/gcc/ada/types.ads +++ b/gcc/ada/types.ads @@ -93,7 +93,7 @@ package Types is EOF : constant Character := ASCII.SUB; -- The character SUB (16#1A#) is used in DOS and other systems derived - -- from DOS (OS/2, NT etc) to signal the end of a text file. Internally + -- from DOS (XP, NT etc) to signal the end of a text file. Internally -- all source files are ended by an EOF character, even on Unix systems. -- An EOF character acts as the end of file only as the last character -- of a source buffer, in any other position, it is treated as a blank diff --git a/gcc/ada/ug_words b/gcc/ada/ug_words index bd4f779fb9e..2582b6360cc 100644 --- a/gcc/ada/ug_words +++ b/gcc/ada/ug_words @@ -140,6 +140,8 @@ gcc -c ^ GNAT COMPILE -gnatwn ^ /WARNINGS=NORMAL -gnatwo ^ /WARNINGS=OVERLAYS -gnatwO ^ /WARNINGS=NOOVERLAYS +-gnatw.o ^ /WARNINGS=OUT_PARAM_UNREF +-gnatw.O ^ /WARNINGS=NOOUT_PARAM_UNREF -gnatwp ^ /WARNINGS=INEFFECTIVE_INLINE -gnatwP ^ /WARNINGS=NOINEFFECTIVE_INLINE -gnatwq ^ /WARNINGS=MISSING_PARENS diff --git a/gcc/ada/uintp.adb b/gcc/ada/uintp.adb index 362d1d03915..4ee886ebc9e 100644 --- a/gcc/ada/uintp.adb +++ b/gcc/ada/uintp.adb @@ -1259,6 +1259,7 @@ package body Uintp is function UI_Div (Left, Right : Uint) return Uint is Quotient : Uint; Remainder : Uint; + pragma Warnings (Off, Remainder); begin UI_Div_Rem (Left, Right, @@ -1536,6 +1537,7 @@ package body Uintp is declare Remainder_V : UI_Vector (1 .. R_Length); Discard_Int : Int; + pragma Warnings (Off, Discard_Int); begin UI_Div_Vector (Dividend (Dividend'Last - R_Length + 1 .. Dividend'Last), @@ -2571,7 +2573,9 @@ package body Uintp is end if; declare - Quotient, Remainder : Uint; + Remainder : Uint; + Quotient : Uint; + pragma Warnings (Off, Quotient); begin UI_Div_Rem (Left, Right, Quotient, Remainder, diff --git a/gcc/ada/usage.adb b/gcc/ada/usage.adb index f7c0f82e20f..ae5ee42268b 100644 --- a/gcc/ada/usage.adb +++ b/gcc/ada/usage.adb @@ -362,7 +362,7 @@ begin Write_Switch_Char ("wxx"); Write_Line ("Enable selected warning modes, xx = list of parameters:"); - Write_Line (" a turn on all optional warnings (except d,h,l,t)"); + Write_Line (" a turn on all optional warnings (except d h l .o)"); Write_Line (" A turn off all optional warnings"); Write_Line (" b turn on warnings for bad fixed value " & "(not multiple of small)"); @@ -400,6 +400,10 @@ begin Write_Line (" n* normal warning mode (cancels -gnatws/-gnatwe)"); Write_Line (" o* turn on warnings for address clause overlay"); Write_Line (" O turn off warnings for address clause overlay"); + Write_Line (" .o turn on warnings for out parameter assigned " & + "but not read"); + Write_Line (" .O* turn off warnings for out parameter assigned " & + "but not read"); Write_Line (" p turn on warnings for ineffective pragma " & "Inline in frontend"); Write_Line (" P* turn off warnings for ineffective pragma " & diff --git a/gcc/ada/validsw.adb b/gcc/ada/validsw.adb index ab6fb937e90..1c7d5cfc63a 100644 --- a/gcc/ada/validsw.adb +++ b/gcc/ada/validsw.adb @@ -104,7 +104,8 @@ package body Validsw is procedure Set_Validity_Check_Options (Options : String) is OK : Boolean; EC : Natural; - + pragma Warnings (Off, OK); + pragma Warnings (Off, EC); begin Set_Validity_Check_Options (Options, OK, EC); end Set_Validity_Check_Options; diff --git a/gcc/ada/vms_data.ads b/gcc/ada/vms_data.ads index a78a3dbf603..5b8d59bd5a7 100644 --- a/gcc/ada/vms_data.ads +++ b/gcc/ada/vms_data.ads @@ -2586,6 +2586,10 @@ package VMS_Data is "!-gnatws,!-gnatwe " & "ALL " & "-gnatwa " & + "OPTIONAL " & + "-gnatwa " & + "NOOPTIONAL " & + "-gnatwA " & "NOALL " & "-gnatwA " & "ALL_GCC " & @@ -2602,20 +2606,20 @@ package VMS_Data is "-gnatw.c " & "NOMISSING_COMPONENT_CLAUSES " & "-gnatw.C " & - "CONSTANT_VARIABLES " & - "-gnatwk " & - "NOCONSTANT_VARIABLES " & - "-gnatwK " & "IMPLICIT_DEREFERENCE " & "-gnatwd " & "NO_IMPLICIT_DEREFERENCE " & "-gnatwD " & - "ELABORATION " & - "-gnatwl " & - "NOELABORATION " & - "-gnatwL " & "ERRORS " & "-gnatwe " & + "UNREFERENCED_FORMALS " & + "-gnatwf " & + "NOUNREFERENCED_FORMALS " & + "-gnatwF " & + "UNRECOGNIZED_PRAGMAS " & + "-gnatwg " & + "NOUNRECOGNIZED_PRAGMAS " & + "-gnatwG " & "HIDING " & "-gnatwh " & "NOHIDING " & @@ -2624,36 +2628,48 @@ package VMS_Data is "-gnatwi " & "NOIMPLEMENTATION " & "-gnatwI " & - "INEFFECTIVE_INLINE " & - "-gnatwp " & - "NOINEFFECTIVE_INLINE " & - "-gnatwP " & - "MISSING_PARENS " & - "-gnatwq " & - "NOMISSING_PARENS " & - "-gnatwQ " & + "OBSOLESCENT " & + "-gnatwj " & + "NOOBSOLESCENT " & + "-gnatwJ " & + "CONSTANT_VARIABLES " & + "-gnatwk " & + "NOCONSTANT_VARIABLES " & + "-gnatwK " & + "ELABORATION " & + "-gnatwl " & + "NOELABORATION " & + "-gnatwL " & "MODIFIED_UNREF " & "-gnatwm " & "NOMODIFIED_UNREF " & "-gnatwM " & "NORMAL " & "-gnatwn " & - "OBSOLESCENT " & - "-gnatwj " & - "NOOBSOLESCENT " & - "-gnatwJ " & - "OPTIONAL " & - "-gnatwa " & - "NOOPTIONAL " & - "-gnatwA " & "OVERLAYS " & "-gnatwo " & "NOOVERLAYS " & "-gnatwO " & + "OUT_PARAM_UNREF " & + "-gnatw.o " & + "NOOUT_PARAM_UNREF " & + "-gnatw.O " & + "INEFFECTIVE_INLINE " & + "-gnatwp " & + "NOINEFFECTIVE_INLINE " & + "-gnatwP " & + "MISSING_PARENS " & + "-gnatwq " & + "NOMISSING_PARENS " & + "-gnatwQ " & "REDUNDANT " & "-gnatwr " & "NOREDUNDANT " & "-gnatwR " & + "OBJECT_RENAMES " & + "-gnatw.r " & + "NOOBJECT_RENAMES " & + "-gnatw.R " & "SUPPRESS " & "-gnatws " & "DELETED_CODE " & @@ -2662,14 +2678,6 @@ package VMS_Data is "-gnatwT " & "UNINITIALIZED " & "-Wuninitialized " & - "UNREFERENCED_FORMALS " & - "-gnatwf " & - "NOUNREFERENCED_FORMALS " & - "-gnatwF " & - "UNRECOGNIZED_PRAGMAS " & - "-gnatwg " & - "NOUNRECOGNIZED_PRAGMAS " & - "-gnatwG " & "UNUSED " & "-gnatwu " & "NOUNUSED " & @@ -2870,20 +2878,15 @@ package VMS_Data is -- NOOBSOLESCENT Disables warnings on use of obsolescent -- features. -- - -- OPTIONAL Activate all optional warning messages. - -- See other options under this qualifier - -- for details on optional warning messages - -- that can be individually controlled. The - -- one exception is that /WARNINGS=OPTIONAL - -- doesn't activate warnings for hiding - -- variables (/WARNINGS=HIDING), so if this - -- warning is required it must be explicitly - -- set. - -- - -- NOOPTIONAL Suppress all optional warning messages. - -- See other options under this qualifier - -- for details on optional warning messages - -- that can be individually controlled. + -- OBJECT_RENAME Activate warnings for non limited objects + -- renaming parameterless functions. + -- + -- NOOBJECT_RENAME Suppress warnings for non limited objects + -- renaming parameterless functions. + -- + -- OPTIONAL Equivalent to ALL. + -- + -- NOOPTIONAL Equivalent to NOALL. -- -- OVERLAYS Activate warnings for possibly unintended -- initialization effects of defining address |