gcc/ada/restrict.adb

   1 ------------------------------------------------------------------------------
   2 --                                                                          --
   3 --                         GNAT COMPILER COMPONENTS                         --
   4 --                                                                          --
   5 --                             R E S T R I C T                              --
   6 --                                                                          --
   7 --                                 B o d y                                  --
   8 --                                                                          --
   9 --          Copyright (C) 1992-2007, Free Software Foundation, Inc.         --
  10 --                                                                          --
  11 -- GNAT is free software;  you can  redistribute it  and/or modify it under --
  12 -- terms of the  GNU General Public License as published  by the Free Soft- --
  13 -- ware  Foundation;  either version 3,  or (at your option) any later ver- --
  14 -- sion.  GNAT is distributed in the hope that it will be useful, but WITH- --
  15 -- OUT ANY WARRANTY;  without even the  implied warranty of MERCHANTABILITY --
  16 -- or FITNESS FOR A PARTICULAR PURPOSE.  See the GNU General Public License --
  17 -- for  more details.  You should have  received  a copy of the GNU General --
  18 -- Public License  distributed with GNAT; see file COPYING3.  If not, go to --
  19 -- http://www.gnu.org/licenses for a complete copy of the license.          --
  20 --                                                                          --
  21 -- GNAT was originally developed  by the GNAT team at  New York University. --
  22 -- Extensive contributions were provided by Ada Core Technologies Inc.      --
  23 --                                                                          --
  24 ------------------------------------------------------------------------------
  25
  26 with Atree;    use Atree;
  27 with Casing;   use Casing;
  28 with Errout;   use Errout;
  29 with Fname;    use Fname;
  30 with Fname.UF; use Fname.UF;
  31 with Lib;      use Lib;
  32 with Opt;      use Opt;
  33 with Sinfo;    use Sinfo;
  34 with Sinput;   use Sinput;
  35 with Snames;   use Snames;
  36 with Uname;    use Uname;
  37
  38 package body Restrict is
  39
  40    Restricted_Profile_Result : Boolean := False;
  41    --  This switch memoizes the result of Restricted_Profile function
  42    --  calls for improved efficiency. Its setting is valid only if
  43    --  Restricted_Profile_Cached is True. Note that if this switch
  44    --  is ever set True, it need never be turned off again.
  45
  46    Restricted_Profile_Cached : Boolean := False;
  47    --  This flag is set to True if the Restricted_Profile_Result
  48    --  contains the correct cached result of Restricted_Profile calls.
  49
  50    -----------------------
  51    -- Local Subprograms --
  52    -----------------------
  53
  54    procedure Restriction_Msg (Msg : String; R : String; N : Node_Id);
  55    --  Output error message at node N with given text, replacing the
  56    --  '%' in the message with the name of the restriction given as R,
  57    --  cased according to the current identifier casing. We do not use
  58    --  the normal insertion mechanism, since this requires an entry
  59    --  in the Names table, and this table will be locked if we are
  60    --  generating a message from gigi.
  61
  62    function Same_Unit (U1, U2 : Node_Id) return Boolean;
  63    --  Returns True iff U1 and U2 represent the same library unit. Used for
  64    --  handling of No_Dependence => Unit restriction case.
  65
  66    function Suppress_Restriction_Message (N : Node_Id) return Boolean;
  67    --  N is the node for a possible restriction violation message, but
  68    --  the message is to be suppressed if this is an internal file and
  69    --  this file is not the main unit.
  70
  71    -------------------
  72    -- Abort_Allowed --
  73    -------------------
  74
  75    function Abort_Allowed return Boolean is
  76    begin
  77       if Restrictions.Set (No_Abort_Statements)
  78         and then Restrictions.Set (Max_Asynchronous_Select_Nesting)
  79         and then Restrictions.Value (Max_Asynchronous_Select_Nesting) = 0
  80       then
  81          return False;
  82       else
  83          return True;
  84       end if;
  85    end Abort_Allowed;
  86
  87    ------------------------------------
  88    -- Check_Elaboration_Code_Allowed --
  89    ------------------------------------
  90
  91    procedure Check_Elaboration_Code_Allowed (N : Node_Id) is
  92    begin
  93       --  Avoid calling Namet.Unlock/Lock except when there is an error.
  94       --  Even in the error case it is a bit dubious, either gigi needs
  95       --  the table locked or it does not! ???
  96
  97       if Restrictions.Set (No_Elaboration_Code)
  98         and then not Suppress_Restriction_Message (N)
  99       then
 100          Namet.Unlock;
 101          Check_Restriction (No_Elaboration_Code, N);
 102          Namet.Lock;
 103       end if;
 104    end Check_Elaboration_Code_Allowed;
 105
 106    ----------------------------------
 107    -- Check_No_Implicit_Heap_Alloc --
 108    ----------------------------------
 109
 110    procedure Check_No_Implicit_Heap_Alloc (N : Node_Id) is
 111    begin
 112       Check_Restriction (No_Implicit_Heap_Allocations, N);
 113    end Check_No_Implicit_Heap_Alloc;
 114
 115    ---------------------------
 116    -- Check_Restricted_Unit --
 117    ---------------------------
 118
 119    procedure Check_Restricted_Unit (U : Unit_Name_Type; N : Node_Id) is
 120    begin
 121       if Suppress_Restriction_Message (N) then
 122          return;
 123
 124       elsif Is_Spec_Name (U) then
 125          declare
 126             Fnam : constant File_Name_Type :=
 127                      Get_File_Name (U, Subunit => False);
 128
 129          begin
 130             --  Get file name
 131
 132             Get_Name_String (Fnam);
 133
 134             --  Nothing to do if name not at least 5 characters long ending
 135             --  in .ads or .adb extension, which we strip.
 136
 137             if Name_Len < 5
 138               or else (Name_Buffer (Name_Len - 3 .. Name_Len) /= ".ads"
 139                          and then
 140                        Name_Buffer (Name_Len - 4 .. Name_Len) /= ".adb")
 141             then
 142                return;
 143             end if;
 144
 145             --  Strip extension and pad to eight characters
 146
 147             Name_Len := Name_Len - 4;
 148             while Name_Len < 8 loop
 149                Name_Len := Name_Len + 1;
 150                Name_Buffer (Name_Len) := ' ';
 151             end loop;
 152
 153             --  If predefined unit, check the list of restricted units
 154
 155             if Is_Predefined_File_Name (Fnam) then
 156                for J in Unit_Array'Range loop
 157                   if Name_Len = 8
 158                     and then Name_Buffer (1 .. 8) = Unit_Array (J).Filenm
 159                   then
 160                      Check_Restriction (Unit_Array (J).Res_Id, N);
 161                   end if;
 162                end loop;
 163
 164                --  If not predefied unit, then one special check still remains.
 165                --  GNAT.Current_Exception is not allowed if we have restriction
 166                --  No_Exception_Propagation active.
 167
 168             else
 169                if Name_Buffer (1 .. 8) = "g-curexc" then
 170                   Check_Restriction (No_Exception_Propagation, N);
 171                end if;
 172             end if;
 173          end;
 174       end if;
 175    end Check_Restricted_Unit;
 176
 177    -----------------------
 178    -- Check_Restriction --
 179    -----------------------
 180
 181    procedure Check_Restriction
 182      (R : Restriction_Id;
 183       N : Node_Id;
 184       V : Uint := Uint_Minus_1)
 185    is
 186       Rimage : constant String := Restriction_Id'Image (R);
 187
 188       VV : Integer;
 189       --  V converted to integer form. If V is greater than Integer'Last,
 190       --  it is reset to minus 1 (unknown value).
 191
 192       procedure Update_Restrictions (Info : in out Restrictions_Info);
 193       --  Update violation information in Info.Violated and Info.Count
 194
 195       -------------------------
 196       -- Update_Restrictions --
 197       -------------------------
 198
 199       procedure Update_Restrictions (Info : in out Restrictions_Info) is
 200       begin
 201          --  If not violated, set as violated now
 202
 203          if not Info.Violated (R) then
 204             Info.Violated (R) := True;
 205
 206             if R in All_Parameter_Restrictions then
 207                if VV < 0 then
 208                   Info.Unknown (R) := True;
 209                   Info.Count (R) := 1;
 210                else
 211                   Info.Count (R) := VV;
 212                end if;
 213             end if;
 214
 215          --  Otherwise if violated already and a parameter restriction,
 216          --  update count by maximizing or summing depending on restriction.
 217
 218          elsif R in All_Parameter_Restrictions then
 219
 220             --  If new value is unknown, result is unknown
 221
 222             if VV < 0 then
 223                Info.Unknown (R) := True;
 224
 225             --  If checked by maximization, do maximization
 226
 227             elsif R in Checked_Max_Parameter_Restrictions then
 228                Info.Count (R) := Integer'Max (Info.Count (R), VV);
 229
 230             --  If checked by adding, do add, checking for overflow
 231
 232             elsif R in Checked_Add_Parameter_Restrictions then
 233                declare
 234                   pragma Unsuppress (Overflow_Check);
 235                begin
 236                   Info.Count (R) := Info.Count (R) + VV;
 237                exception
 238                   when Constraint_Error =>
 239                      Info.Count (R) := Integer'Last;
 240                      Info.Unknown (R) := True;
 241                end;
 242
 243             --  Should not be able to come here, known counts should only
 244             --  occur for restrictions that are Checked_max or Checked_Sum.
 245
 246             else
 247                raise Program_Error;
 248             end if;
 249          end if;
 250       end Update_Restrictions;
 251
 252    --  Start of processing for Check_Restriction
 253
 254    begin
 255       if UI_Is_In_Int_Range (V) then
 256          VV := Integer (UI_To_Int (V));
 257       else
 258          VV := -1;
 259       end if;
 260
 261       --  Count can only be specified in the checked val parameter case
 262
 263       pragma Assert (VV < 0 or else R in Checked_Val_Parameter_Restrictions);
 264
 265       --  Nothing to do if value of zero specified for parameter restriction
 266
 267       if VV = 0 then
 268          return;
 269       end if;
 270
 271       --  Update current restrictions
 272
 273       Update_Restrictions (Restrictions);
 274
 275       --  If in main extended unit, update main restrictions as well
 276
 277       if Current_Sem_Unit = Main_Unit
 278         or else In_Extended_Main_Source_Unit (N)
 279       then
 280          Update_Restrictions (Main_Restrictions);
 281       end if;
 282
 283       --  Nothing to do if restriction message suppressed
 284
 285       if Suppress_Restriction_Message (N) then
 286          null;
 287
 288       --  If restriction not set, nothing to do
 289
 290       elsif not Restrictions.Set (R) then
 291          null;
 292
 293       --  Here if restriction set, check for violation (either this is a
 294       --  Boolean restriction, or a parameter restriction with a value of
 295       --  zero and an unknown count, or a parameter restriction with a
 296       --  known value that exceeds the restriction count).
 297
 298       elsif R in All_Boolean_Restrictions
 299         or else (Restrictions.Unknown (R)
 300                    and then Restrictions.Value (R) = 0)
 301         or else Restrictions.Count (R) > Restrictions.Value (R)
 302       then
 303          Error_Msg_Sloc := Restrictions_Loc (R);
 304
 305          --  If we have a location for the Restrictions pragma, output it
 306
 307          if Error_Msg_Sloc > No_Location
 308            or else Error_Msg_Sloc = System_Location
 309          then
 310             if Restriction_Warnings (R) then
 311                Restriction_Msg ("|violation of restriction %#?", Rimage, N);
 312             else
 313                Restriction_Msg ("|violation of restriction %#", Rimage, N);
 314             end if;
 315
 316          --  Otherwise we have the case of an implicit restriction
 317          --  (e.g. a restriction implicitly set by another pragma)
 318
 319          else
 320             Restriction_Msg
 321               ("|violation of implicit restriction %", Rimage, N);
 322          end if;
 323       end if;
 324    end Check_Restriction;
 325
 326    -------------------------------------
 327    -- Check_Restriction_No_Dependence --
 328    -------------------------------------
 329
 330    procedure Check_Restriction_No_Dependence (U : Node_Id; Err : Node_Id) is
 331       DU : Node_Id;
 332
 333    begin
 334       for J in No_Dependence.First .. No_Dependence.Last loop
 335          DU := No_Dependence.Table (J).Unit;
 336
 337          if Same_Unit (U, DU) then
 338             Error_Msg_Sloc := Sloc (DU);
 339             Error_Msg_Node_1 := DU;
 340
 341             if No_Dependence.Table (J).Warn then
 342                Error_Msg
 343                  ("?violation of restriction `No_Dependence '='> &`#",
 344                   Sloc (Err));
 345             else
 346                Error_Msg
 347                  ("|violation of restriction `No_Dependence '='> &`#",
 348                   Sloc (Err));
 349             end if;
 350
 351             return;
 352          end if;
 353       end loop;
 354    end Check_Restriction_No_Dependence;
 355
 356    ----------------------------------------
 357    -- Cunit_Boolean_Restrictions_Restore --
 358    ----------------------------------------
 359
 360    procedure Cunit_Boolean_Restrictions_Restore
 361      (R : Save_Cunit_Boolean_Restrictions)
 362    is
 363    begin
 364       for J in Cunit_Boolean_Restrictions loop
 365          Restrictions.Set (J) := R (J);
 366       end loop;
 367    end Cunit_Boolean_Restrictions_Restore;
 368
 369    -------------------------------------
 370    -- Cunit_Boolean_Restrictions_Save --
 371    -------------------------------------
 372
 373    function Cunit_Boolean_Restrictions_Save
 374      return Save_Cunit_Boolean_Restrictions
 375    is
 376       R : Save_Cunit_Boolean_Restrictions;
 377
 378    begin
 379       for J in Cunit_Boolean_Restrictions loop
 380          R (J) := Restrictions.Set (J);
 381          Restrictions.Set (J) := False;
 382       end loop;
 383
 384       return R;
 385    end Cunit_Boolean_Restrictions_Save;
 386
 387    ------------------------
 388    -- Get_Restriction_Id --
 389    ------------------------
 390
 391    function Get_Restriction_Id
 392      (N : Name_Id) return Restriction_Id
 393    is
 394    begin
 395       Get_Name_String (N);
 396       Set_Casing (All_Upper_Case);
 397
 398       for J in All_Restrictions loop
 399          declare
 400             S : constant String := Restriction_Id'Image (J);
 401          begin
 402             if S = Name_Buffer (1 .. Name_Len) then
 403                return J;
 404             end if;
 405          end;
 406       end loop;
 407
 408       return Not_A_Restriction_Id;
 409    end Get_Restriction_Id;
 410
 411    -------------------------------
 412    -- No_Exception_Handlers_Set --
 413    -------------------------------
 414
 415    function No_Exception_Handlers_Set return Boolean is
 416    begin
 417       return (No_Run_Time_Mode or else Configurable_Run_Time_Mode)
 418         and then (Restrictions.Set (No_Exception_Handlers)
 419                     or else
 420                   Restrictions.Set (No_Exception_Propagation));
 421    end No_Exception_Handlers_Set;
 422
 423    ----------------------------------
 424    -- Process_Restriction_Synonyms --
 425    ----------------------------------
 426
 427    --  Note: body of this function must be coordinated with list of
 428    --  renaming declarations in System.Rident.
 429
 430    function Process_Restriction_Synonyms (N : Node_Id) return Name_Id
 431    is
 432       Old_Name : constant Name_Id := Chars (N);
 433       New_Name : Name_Id;
 434
 435    begin
 436       case Old_Name is
 437          when Name_Boolean_Entry_Barriers =>
 438             New_Name := Name_Simple_Barriers;
 439
 440          when Name_Max_Entry_Queue_Depth =>
 441             New_Name := Name_Max_Entry_Queue_Length;
 442
 443          when Name_No_Dynamic_Interrupts =>
 444             New_Name := Name_No_Dynamic_Attachment;
 445
 446          when Name_No_Requeue =>
 447             New_Name := Name_No_Requeue_Statements;
 448
 449          when Name_No_Task_Attributes =>
 450             New_Name := Name_No_Task_Attributes_Package;
 451
 452          when others =>
 453             return Old_Name;
 454       end case;
 455
 456       if Warn_On_Obsolescent_Feature then
 457          Error_Msg_Name_1 := Old_Name;
 458          Error_Msg_N ("restriction identifier % is obsolescent?", N);
 459          Error_Msg_Name_1 := New_Name;
 460          Error_Msg_N ("|use restriction identifier % instead", N);
 461       end if;
 462
 463       return New_Name;
 464    end Process_Restriction_Synonyms;
 465
 466    ------------------------
 467    -- Restricted_Profile --
 468    ------------------------
 469
 470    function Restricted_Profile return Boolean is
 471    begin
 472       if Restricted_Profile_Cached then
 473          return Restricted_Profile_Result;
 474
 475       else
 476          Restricted_Profile_Result := True;
 477          Restricted_Profile_Cached := True;
 478
 479          declare
 480             R : Restriction_Flags  renames Profile_Info (Restricted).Set;
 481             V : Restriction_Values renames Profile_Info (Restricted).Value;
 482          begin
 483             for J in R'Range loop
 484                if R (J)
 485                  and then (Restrictions.Set (J) = False
 486                              or else Restriction_Warnings (J)
 487                              or else
 488                                (J in All_Parameter_Restrictions
 489                                   and then Restrictions.Value (J) > V (J)))
 490                then
 491                   Restricted_Profile_Result := False;
 492                   exit;
 493                end if;
 494             end loop;
 495
 496             return Restricted_Profile_Result;
 497          end;
 498       end if;
 499    end Restricted_Profile;
 500
 501    ------------------------
 502    -- Restriction_Active --
 503    ------------------------
 504
 505    function Restriction_Active (R : All_Restrictions) return Boolean is
 506    begin
 507       return Restrictions.Set (R) and then not Restriction_Warnings (R);
 508    end Restriction_Active;
 509
 510    ---------------------
 511    -- Restriction_Msg --
 512    ---------------------
 513
 514    procedure Restriction_Msg (Msg : String; R : String; N : Node_Id) is
 515       B : String (1 .. Msg'Length + 2 * R'Length + 1);
 516       P : Natural := 1;
 517
 518    begin
 519       Name_Buffer (1 .. R'Last) := R;
 520       Name_Len := R'Length;
 521       Set_Casing (Identifier_Casing (Get_Source_File_Index (Sloc (N))));
 522
 523       P := 0;
 524       for J in Msg'Range loop
 525          if Msg (J) = '%' then
 526             P := P + 1;
 527             B (P) := '`';
 528
 529             --  Put characters of image in message, quoting upper case letters
 530
 531             for J in 1 .. Name_Len loop
 532                if Name_Buffer (J) in 'A' .. 'Z' then
 533                   P := P + 1;
 534                   B (P) := ''';
 535                end if;
 536
 537                P := P + 1;
 538                B (P) := Name_Buffer (J);
 539             end loop;
 540
 541             P := P + 1;
 542             B (P) := '`';
 543
 544          else
 545             P := P + 1;
 546             B (P) := Msg (J);
 547          end if;
 548       end loop;
 549
 550       Error_Msg_N (B (1 .. P), N);
 551    end Restriction_Msg;
 552
 553    ---------------
 554    -- Same_Unit --
 555    ---------------
 556
 557    function Same_Unit (U1, U2 : Node_Id) return Boolean is
 558    begin
 559       if Nkind (U1) = N_Identifier then
 560          return Nkind (U2) = N_Identifier and then Chars (U1) = Chars (U2);
 561
 562       elsif Nkind (U2) = N_Identifier then
 563          return False;
 564
 565       elsif (Nkind (U1) = N_Selected_Component
 566              or else Nkind (U1) = N_Expanded_Name)
 567         and then
 568           (Nkind (U2) = N_Selected_Component
 569            or else Nkind (U2) = N_Expanded_Name)
 570       then
 571          return Same_Unit (Prefix (U1), Prefix (U2))
 572            and then Same_Unit (Selector_Name (U1), Selector_Name (U2));
 573       else
 574          return False;
 575       end if;
 576    end Same_Unit;
 577
 578    ------------------------------
 579    -- Set_Profile_Restrictions --
 580    ------------------------------
 581
 582    procedure Set_Profile_Restrictions
 583      (P    : Profile_Name;
 584       N    : Node_Id;
 585       Warn : Boolean)
 586    is
 587       R : Restriction_Flags  renames Profile_Info (P).Set;
 588       V : Restriction_Values renames Profile_Info (P).Value;
 589
 590    begin
 591       for J in R'Range loop
 592          if R (J) then
 593             declare
 594                Already_Restricted : constant Boolean := Restriction_Active (J);
 595
 596             begin
 597                --  Set the restriction
 598
 599                if J in All_Boolean_Restrictions then
 600                   Set_Restriction (J, N);
 601                else
 602                   Set_Restriction (J, N, V (J));
 603                end if;
 604
 605                --  Set warning flag, except that we do not set the warning
 606                --  flag if the restriction was already active and this is
 607                --  the warning case. That avoids a warning overriding a real
 608                --  restriction, which should never happen.
 609
 610                if not (Warn and Already_Restricted) then
 611                   Restriction_Warnings (J) := Warn;
 612                end if;
 613             end;
 614          end if;
 615       end loop;
 616    end Set_Profile_Restrictions;
 617
 618    ---------------------
 619    -- Set_Restriction --
 620    ---------------------
 621
 622    --  Case of Boolean restriction
 623
 624    procedure Set_Restriction
 625      (R : All_Boolean_Restrictions;
 626       N : Node_Id)
 627    is
 628    begin
 629       --  Restriction No_Elaboration_Code must be enforced on a unit by unit
 630       --  basis. Hence, we avoid setting the restriction when processing an
 631       --  unit which is not the main one being compiled (or its corresponding
 632       --  spec). It can happen, for example, when processing an inlined body
 633       --  (the package containing the inlined subprogram is analyzed,
 634       --  including its pragma Restrictions).
 635
 636       --  This seems like a very nasty kludge??? This is not the only per unit
 637       --  restriction why is this treated specially ???
 638
 639       if R = No_Elaboration_Code
 640         and then Current_Sem_Unit /= Main_Unit
 641         and then Cunit (Current_Sem_Unit) /= Library_Unit (Cunit (Main_Unit))
 642       then
 643          return;
 644       end if;
 645
 646       Restrictions.Set (R) := True;
 647
 648       if Restricted_Profile_Cached and Restricted_Profile_Result then
 649          null;
 650       else
 651          Restricted_Profile_Cached := False;
 652       end if;
 653
 654       --  Set location, but preserve location of system
 655       --  restriction for nice error msg with run time name
 656
 657       if Restrictions_Loc (R) /= System_Location then
 658          Restrictions_Loc (R) := Sloc (N);
 659       end if;
 660
 661       --  Record the restriction if we are in the main unit, or in the extended
 662       --  main unit. The reason that we test separately for Main_Unit is that
 663       --  gnat.adc is processed with Current_Sem_Unit = Main_Unit, but nodes in
 664       --  gnat.adc do not appear to be in the extended main source unit (they
 665       --  probably should do ???)
 666
 667       if Current_Sem_Unit = Main_Unit
 668         or else In_Extended_Main_Source_Unit (N)
 669       then
 670          if not Restriction_Warnings (R) then
 671             Main_Restrictions.Set (R) := True;
 672          end if;
 673       end if;
 674    end Set_Restriction;
 675
 676    --  Case of parameter restriction
 677
 678    procedure Set_Restriction
 679      (R : All_Parameter_Restrictions;
 680       N : Node_Id;
 681       V : Integer)
 682    is
 683    begin
 684       if Restricted_Profile_Cached and Restricted_Profile_Result then
 685          null;
 686       else
 687          Restricted_Profile_Cached := False;
 688       end if;
 689
 690       if Restrictions.Set (R) then
 691          if V < Restrictions.Value (R) then
 692             Restrictions.Value (R) := V;
 693             Restrictions_Loc (R) := Sloc (N);
 694          end if;
 695
 696       else
 697          Restrictions.Set (R) := True;
 698          Restrictions.Value (R) := V;
 699          Restrictions_Loc (R) := Sloc (N);
 700       end if;
 701
 702       --  Record the restriction if we are in the main unit,
 703       --  or in the extended main unit. The reason that we
 704       --  test separately for Main_Unit is that gnat.adc is
 705       --  processed with Current_Sem_Unit = Main_Unit, but
 706       --  nodes in gnat.adc do not appear to be the extended
 707       --  main source unit (they probably should do ???)
 708
 709       if Current_Sem_Unit = Main_Unit
 710         or else In_Extended_Main_Source_Unit (N)
 711       then
 712          if Main_Restrictions.Set (R) then
 713             if V < Main_Restrictions.Value (R) then
 714                Main_Restrictions.Value (R) := V;
 715             end if;
 716
 717          elsif not Restriction_Warnings (R) then
 718             Main_Restrictions.Set (R) := True;
 719             Main_Restrictions.Value (R) := V;
 720          end if;
 721       end if;
 722    end Set_Restriction;
 723
 724    -----------------------------------
 725    -- Set_Restriction_No_Dependence --
 726    -----------------------------------
 727
 728    procedure Set_Restriction_No_Dependence
 729      (Unit : Node_Id;
 730       Warn : Boolean)
 731    is
 732    begin
 733       --  Loop to check for duplicate entry
 734
 735       for J in No_Dependence.First .. No_Dependence.Last loop
 736
 737          --  Case of entry already in table
 738
 739          if Same_Unit (Unit, No_Dependence.Table (J).Unit) then
 740
 741             --  Error has precedence over warning
 742
 743             if not Warn then
 744                No_Dependence.Table (J).Warn := False;
 745             end if;
 746
 747             return;
 748          end if;
 749       end loop;
 750
 751       --  Entry is not currently in table
 752
 753       No_Dependence.Append ((Unit, Warn));
 754    end Set_Restriction_No_Dependence;
 755
 756    ----------------------------------
 757    -- Suppress_Restriction_Message --
 758    ----------------------------------
 759
 760    function Suppress_Restriction_Message (N : Node_Id) return Boolean is
 761    begin
 762       --  We only output messages for the extended main source unit
 763
 764       if In_Extended_Main_Source_Unit (N) then
 765          return False;
 766
 767       --  If loaded by rtsfind, then suppress message
 768
 769       elsif Sloc (N) <= No_Location then
 770          return True;
 771
 772       --  Otherwise suppress message if internal file
 773
 774       else
 775          return Is_Internal_File_Name (Unit_File_Name (Get_Source_Unit (N)));
 776       end if;
 777    end Suppress_Restriction_Message;
 778
 779    ---------------------
 780    -- Tasking_Allowed --
 781    ---------------------
 782
 783    function Tasking_Allowed return Boolean is
 784    begin
 785       return not Restrictions.Set (No_Tasking)
 786         and then (not Restrictions.Set (Max_Tasks)
 787                     or else Restrictions.Value (Max_Tasks) > 0);
 788    end Tasking_Allowed;
 789
 790 end Restrict;